home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d10 / ps1410.arc / CAL3.BAS < prev    next >
BASIC Source File  |  1990-10-31  |  77KB  |  2,070 lines
  1.     '=========================================================================
  2.     ' Personal Calendar (PC) Program
  3.     '  Copyright (c) 1985-1990, Paul Munoz-Colman.  All Rights Reserved.
  4.     '    Version 14.10
  5.     '     31 Oct 1990
  6.     '    Shareware $25
  7.     '=========================================================================
  8.     '              DOS File CAL3.BAS
  9.     '  Independently Compiled Subprograms Which Are Linked With CAL1.BAS
  10.     '=========================================================================
  11.     '  Written For IBM PCs & Compatibles Under MS DOS 3.30 on a Northgate 486
  12.     '   Compiled By Microsoft Professional BASIC 7.10, Linker Version 5.10
  13.     '=========================================================================
  14.     '  Note -- Tabs in the source file are in positions 6,11,16,21,26,...
  15.     '=========================================================================
  16.     ' $INCLUDE: 'cal1.bi'
  17.     '=========================================================================
  18.     '  Subprogram List in the Order of Appearance in this File
  19.     '   (compiled WITHOUT error handling--no /E or /X)
  20.     '-------------------------------------------------------------------------
  21.     '    Name                          Purpose
  22.     '    ---------------------------   ---------------------------------------
  23.     '    ApptToMenu (EntryPoint)        Raw Appt Rec to Menu and Vice Versa
  24.     ' Fn ASCIIN$ (ASCIIZString$)       Strip Chr$(0) From ASCIIZ String
  25.     ' Fn ASCIIZ$ (ASCIIString$)        Add Chr$(0) to ASCII String
  26.     '    AutoStart                     Automatic Startup Setting Menu
  27.     '    BigChars (CharsLin%, CharsColumn%, ChLin$)  Interface with MhChars
  28.     '    BlankError                    Clear Error Message
  29.     '    BlankFatal                    Clear Fatal Error (2 lines)
  30.     ' Fn BlankFill$ (ToBlankFill$)     Leading Zeroes to Blanks in String
  31.     '    BoxDraw (Type, Top, Bottom, Left, Right)   Draw Box with MhBox
  32.     '    BuildMenuLine                 Construct Menu Event Line    
  33.     '    CheckDate (DatetoValidate$)   See If Date Is Really a Date
  34.     '    ClearLast3                    Blank Last 3 Screen Lines
  35.     '    ClearLast4                    Blank Last 4    "
  36.     '    ClearOverdueTable             Clear Events Overdue Listing 
  37.     '    ClearScreenNormal (TimerDesired)
  38.     '                                  Clear Screen with Cl1f,Cl1b colors
  39.     '    CloseFiles                    Close All Data Files
  40.     '    ColorDecode (ColorAttribute)  Get Colors from Attribute
  41.     '    CombineDateTime               Merge Date/Time Fields
  42.     '    CompressApptFile (ShrinkNumber)
  43.     '                                  Compress Appt File ShrinkNumber Recs
  44.     '    ComputePendingValue (AlarmValue#,PendingValue#)
  45.     '                                  Calculate Warning Date/Time
  46.     '    ControlledInput (BoxRow,BoxColumn,MessageRow,MessageColumn,Length,_
  47.     '         MessageText$,InputResponse$,NumlockRequest,FilenameShow,_
  48.     '         ScreenBottomsShow,HoldAtEnd)  General Input Routine
  49.     '    Credits (WhichLine)            Address, phone number, regi info
  50.     '    DayDate (DatetoIndex$)        Get Day of Week and count for a Date
  51.     ' Fn    DirectoryExist(DirectoryName$) Interface with MhDirExist
  52.     '    DirectReturnCheck             Whether Returning To Clock Screen
  53.     '    DisplayApptFilename           Show Appointment File Name on Menus
  54.     '    DOSBIOSServices            Interface to MhDOS2
  55.     '    DoShell (ShellCommand$)       Run a Shell Command
  56.     '    DOSShell                      Run DOS Session and Return
  57.     '    EndItAll                      Return to DOS
  58.     '    ErrorHandler                  Error Condition Message Generator
  59.     '    EscapeLine                    Esc to Return Instruction
  60.     '    EscapeLineDelete              Esc to Return Instruction Blankout
  61.     '    EventErrorMessage             Display Error On Editing Instructions
  62.     ' Fn FileExist(ExistFilename$)    Interface with MhFileExist
  63.     '    FileFormat                    Change Number of Notes/Events in File
  64.     '    FileList                      Display List of Appointment Files
  65.     '    GenerateGreeting              Display Main Menu Greeting
  66.     '    GenGreetingScreen1            Startup Screen
  67.     '    GetFilenameLength             Get Length of Appointment File Name
  68.     '    GetOptions                    Read Options from Appointment File
  69.     '    Help                          Help Function
  70.     '    IncrementDate (DatetoIncrement$)
  71.     '                                  Change a Date to the Next Date
  72.     '    InitPrinter                   Initialize Printer w/Control Codes
  73.     '=========================================================================
  74.     SUB ApptToMenu (EntryPoint) STATIC
  75.     '=========================================================================
  76.     '  Convert Raw Appt Record to Menu Item (Entry Point 1)
  77.     '  Convert Menu Item to Raw Appt Recrd  (Entry Point 2) -- future use
  78.     DEFINT A-Z
  79.         SubnumSave = Subnum
  80.         Subnum = 133
  81.     CALL GetApptRecord(N1+WhichEvent)    'Fills CurrentEventRecord$
  82.     CALL UnpackApptRecord            'Gets Individual Event Elements
  83.     CALL CombineDateTime            'Gets Day of Week
  84.     CALL BuildMenuLine                'Fills CurrentEventLine$
  85.         Subnum = SubnumSave
  86.     END SUB
  87.     '=========================================================================
  88.     FUNCTION ASCIIN$ (ASCIIZString$) STATIC
  89.     '=========================================================================
  90.     DEFINT A-Z
  91.         SubnumSave = Subnum
  92.         Subnum = 2
  93.     ' Take the Chr$(0) off an ASCIIZ String for Mh Routines
  94.     ZeroPosition = InString(ASCIIZString$, CHR$(N0))
  95.     IF ZeroPosition THEN
  96.         ASCIIN$ = LEFT$(ASCIIZString$, ZeroPosition - N1)
  97.       ELSE
  98.         ASCIIN$ = ASCIIZString$
  99.     END IF
  100.         Subnum = SubnumSave
  101.     END FUNCTION
  102.     '=========================================================================
  103.     FUNCTION ASCIIZ$ (ASCIIString$) STATIC
  104.     '=========================================================================
  105.     DEFINT A-Z
  106.         SubnumSave = Subnum
  107.         Subnum = 3
  108.     ' Add the Chr$(0) to an ASCII String for Mh Mach2 Routines
  109.     IF RIGHT$(ASCIIString$, N1) <> CHR$(N0) THEN 
  110.         ASCIIZ$ = ASCIIString$ + CHR$(N0)
  111.       ELSE
  112.         ASCIIZ$ = ASCIIString$
  113.     END IF
  114.         Subnum = SubnumSave
  115.     END FUNCTION
  116.     '=========================================================================
  117.     SUB AutoStart STATIC
  118.     '=========================================================================
  119.     '   Automatic Startup and TSR Mode (if DOS 3 or later) options
  120.     DEFINT A-Z
  121.         SubnumSave = Subnum
  122.         Subnum = 4
  123. BeginAuto:
  124.     CALL ClearScreenNormal(N1)
  125.     '------------------------------------------------------------------------
  126.     IF NOT DOS2x THEN
  127.         ScreenTitles$(N1) = "Memory-Resident Options and Automatic Startup"
  128.         CALL Titles(Nm1)
  129.         MenuSize = N2
  130.         MenuLines(N1) = "Memory-Resident (TSR Mode) Options"
  131.         MenuLines(N2) = "Automatic Startup Options"
  132.         CALL MenuDriver(MenuSize, MenuAutoTSR, N7, Nm1, _
  133.             No, N0, N1, N1)
  134.         IF MenuExit = MenuCancelled THEN
  135.             CALL DirectReturnCheck
  136.             CALL ClearScreenNormal(N1)
  137.             GOTO ExitPoint
  138.         END IF
  139.         SELECT CASE MenuAutoTSR
  140.             CASE 1                   ' TSR Options Menu
  141.                 CALL StayResOptions(No)
  142.             CASE 2                   ' Autostart Options Menu
  143.                 ActionNote = N0
  144.                 GOTO BuildAutoMenu
  145.         END SELECT
  146.         GOTO BeginAuto
  147.     END IF
  148.     '------------------------------------------------------------------------
  149. BuildAutoMenu:
  150.     CALL ClearScreenNormal(N1)
  151.     ScreenTitles$(N1) = "Automatic Startup"
  152.     CALL Titles(Nm1)
  153.     SELECT CASE ActionNote
  154.         CASE 0        ' No Message
  155.         CASE 1        ' Auto/Appointment
  156.             ActionMessage$ = "Automatic Startup Set With Appointment File"
  157.         CASE 2        ' Auto/No Appointment
  158.             ActionMessage$ = "Automatic Startup Set Without Appointment File"
  159.         CASE 3        ' Manual
  160.             ActionMessage$ = "Manual Startup Set"
  161.         CASE 4
  162.             IF ForceDate THEN
  163.                 ActionMessage$ = "Set to Ask For Input of Date/Time"
  164.               ELSE
  165.                 ActionMessage$ = "Will Not Ask For Input of Date/Time"
  166.             END IF
  167.     END SELECT
  168.     IF ActionNote THEN
  169.         CALL PrepareforMessage
  170.         CALL ShowIt(N0,N0,N0,ActionMessage$)
  171.         ActionNote = N0
  172.     END IF
  173.     MenuSize = 4
  174.     MenuRow = N7
  175.     MenuLines(N1) = "Automatic Startup With Appointment File"
  176.     MenuLines(N2) = "Automatic Startup With Clock and Calendar Only"
  177.     MenuLines(N3) = "Manual Startup"
  178.     MenuLines(4) = _
  179.         "Ask For Date and Time When Program Starts, Currently "
  180.     CALL MhNotBackwardInstr(Pointer%, N1%, (MenuLines(N4)), N32%)
  181.     IF ForceDate THEN
  182.         ScreenTag$ = Yess$
  183.       ELSE
  184.         ScreenTag$ = "No "
  185.     END IF
  186.     CALL Myd2(MenuLines(N4), Pointer + N2, N3, ScreenTag$)
  187.     CALL MenuDriver(MenuSize, MenuAuto, MenuRow, Nm1, No, N0, N1, N1)
  188.     CALL BlankError
  189.     IF MenuExit = MenuCancelled THEN
  190.         CALL DirectReturnCheck
  191.         CALL ClearScreenNormal(N1)
  192.         IF NOT DOS2x THEN GOTO BeginAuto ELSE GOTO ExitPoint
  193.     END IF
  194.     ActionNote = MenuAuto
  195.     '------------------------------------------------------------------------
  196.     SELECT CASE MenuAuto
  197.         CASE 1    ' Autostart with Appt File
  198.             AutostartMode = Yes
  199.             BoxRow = MenuRow + MenuSize + 4
  200.             MessageRow = BoxRow
  201.             InputResponse$ = ApptFilename$
  202.             CALL ControlledInput(BoxRow, N40, MessageRow, N1, N8, _
  203.                 "Enter Appointment File Name", InputResponse$, _
  204.                 N0, N1, N1, N1)
  205.             IF Keystroke$ = CHR$(Esc) THEN GOTO BuildAutoMenu
  206.             IF InputResponse$ <> ApptFilename$ THEN EventTableStable = No
  207.             ApptFilename$ = InputResponse$
  208.             '   File Password
  209.             BoxRow = MenuRow + MenuSize + 5
  210.             MessageRow = BoxRow
  211. PasswordCheck:
  212.             FOR I = N1 TO N2
  213.                 IF I = N1 THEN
  214.                     MessageText$ = "Enter Appointment File Password     "
  215.                   ELSE
  216.                     MessageText$ = "Re-Enter Password To Confirm, Please"
  217.                 END IF
  218.                 InputResponse$ = SPACE$(8)
  219.                 EchoSuppression = Yes
  220.                 CALL ControlledInput(BoxRow, N40, MessageRow, N1, N8, _
  221.                     MessageText$, InputResponse$, N0, N1, N1, N1)
  222.                 EchoSuppression = No
  223.                 IF Keystroke$ = CHR$(Esc) THEN GOTO BuildAutoMenu
  224.                 CALL BlankFatal
  225.                 IF I = N1 THEN PasswordHold$ = InputResponse$
  226.             NEXT
  227.             IF PasswordHold$ <> InputResponse$ THEN
  228.                 CALL MajorBeeper
  229.                 CALL Kolors(N14)
  230.                 CALL BlankError
  231.                 CALL ShowIt(N0, N0, N0, _
  232.                     "Password Confirmation Doesn't Match -- Try Again")
  233.                 GOTO PasswordCheck
  234.             END IF
  235.             ApptPassword$ = InputResponse$
  236.             EnteredPassword$ = InputResponse$
  237.         CASE 2    ' Autostart without Appt File
  238.             EventTableStable = No
  239.             ApptFilename$ = Blank8$
  240.             ApptPassword$ = Blank8$
  241.             AutostartMode = Yes
  242.         CASE 3    ' Manual start (later without appointment file)
  243.             AutostartMode = No
  244.         CASE 4
  245.             IF ForceDate THEN        '  Force DOS Date/Time Set
  246.                 ForceDate = No        '   on Program Start
  247.               ELSE
  248.                 ForceDate = Yes
  249.             END IF
  250.     END SELECT
  251.     CALL WriteCalauto                  '  Rewrite CALAUTO.DAT File
  252.     GOTO BuildAutoMenu
  253. ExitPoint:
  254.         Subnum = SubnumSave
  255.     END SUB
  256.     '=========================================================================
  257.     SUB BigChars (CharRow%, CharColumn%, CharLin$)  STATIC
  258.     '=========================================================================
  259.     DEFINT A-Z
  260.         SubnumSave = Subnum
  261.         Subnum = 136
  262.     ' Interface with MhChars
  263.     SPage% = ScreenPage%            ' Error in MhChars changes the value
  264.     CAttribute% = ColorAttribute%        ' of CColumn on return from the 
  265.     CRow% = CharRow%                ' routine
  266.     CColumn% = CharColumn%
  267.     CLin$ = CharLin$
  268.     CALL MhChars (SPage%, CRow%, CColumn%, CAttribute%, CLin$)
  269.         Subnum = SubnumSave
  270.     END SUB
  271.     '=========================================================================
  272.     SUB BlankError STATIC
  273.     '=========================================================================
  274.     DEFINT A-Z
  275.         SubnumSave = Subnum
  276.         Subnum = 5
  277.     CALL ShowErase(N0, ErrMsgPlacement, N1, N80, Blank0$)
  278.         Subnum = SubnumSave
  279.     END SUB
  280.     '=========================================================================
  281.     SUB BlankFatal STATIC
  282.     '=========================================================================
  283.     DEFINT A-Z
  284.         SubnumSave = Subnum
  285.         Subnum = 6
  286.     FOR I = N1 TO N2
  287.         CALL ShowErase(N0, (ErrMsgPlacement + I - N1), N1, N80, Blank0$)
  288.     NEXT
  289.         Subnum = SubnumSave
  290.     END SUB
  291.     '=========================================================================
  292.     FUNCTION BlankFill$ (ToBlankFill$) STATIC
  293.     '=========================================================================
  294.     DEFINT A-Z
  295.         SubnumSave = Subnum
  296.         Subnum = 7
  297.     '  Fill leading Zeroes with Blanks
  298.     BlankDummy$ = ToBlankFill$            ' Save String
  299.     IF LEN(BlankDummy$) THEN                ' If non-null, find first non-zero
  300.         CALL MhNotInstr(FirstNonZero%, Start%, BlankDummy$, N48%)
  301.         IF FirstNonZero > N1 THEN        'if one in pos 2 or more => zeroes
  302.             ToFill = FirstNonZero - N1    '  Fill them all with blanks
  303.             CALL Myd2(BlankDummy$, N1, ToFill, Strng$(ToFill, N32))
  304.         END IF
  305.     END IF
  306.     BlankFill$ = BlankDummy$            ' and save the result
  307.         Subnum = SubnumSave
  308.     END FUNCTION
  309.     '=========================================================================
  310.     SUB BoxDraw (BoxType, BoxTop, BoxBottom, BoxLeft, BoxRight)  STATIC
  311.     '=========================================================================
  312.     '   Draw a Box with MhBox, Simplifying Calling Parameters
  313.     DEFINT A-Z
  314.         SubnumSave = Subnum
  315.         Subnum = 32
  316.     CALL MhBox(ColorAttribute%, BoxType%, ColorAttribute%, ScreenPage%, _
  317.             BoxTop%, BoxLeft%, BoxBottom%, BoxRight%)
  318.         Subnum = SubnumSave
  319.     END SUB
  320.     '=========================================================================
  321.     SUB BuildMenuLine  STATIC
  322.     '=========================================================================
  323.     '   Construct Individual Event Menu Line--Compute Day Of Week
  324.     DEFINT A-Z
  325.         SubnumSave = Subnum
  326.         Subnum = 103
  327.     IF CurrentEventRecord$ = Blank80$ THEN
  328.         CALL MhLset(CurrentEventLine$, NullEvent$)
  329.         GOTO ExitPoint0
  330.     END IF
  331.     ScreenTag$ = Blank3$
  332.     IF EventDate$ <> Blank8$ THEN ' First Try To Get It From The
  333.         J = N0         ' Weekly or Monthly "N" Day Indicator Digit
  334.         ErrorSwitch = No
  335.         IF InString("BbWwNn123456789", MID$(EventRepeat$, N1, N1)) THEN
  336.             J = VAL(MID$(EventRepeat$, N2, N1))
  337.         END IF
  338.         IF J <= N0 OR J >= 8 THEN      'If Not There or No Good
  339.             '  Compute It From The Date
  340.             CALL BuildMenuDate(EventDate$)    ' does error handling
  341.             J = IndexedDay
  342.         END IF
  343.         IF NOT ErrorSwitch THEN
  344.             '-----------------------------------------------------
  345.             ' Get The Alphabetic Day Of The Week For The Display
  346.             CALL Myd2(ScreenTag$, N1, N3, DayNames$(J))
  347.         END IF
  348.         ErrorSwitch = No
  349.     END IF
  350.     '-------------------------------------------------------------------------
  351.     '     Place Each Data Field Where It Belongs In The Menu Line
  352.     IF EventLimRepeat$ = Blank2$ THEN
  353.         CALL Myd2(LimSep$, N1, N1, Blank1$)
  354.       ELSE 
  355.         CALL Myd2(LimSep$, N1, N1, Hyphen$)
  356.     END IF
  357.     CALL Myd2(CurrentEventLine$, N1, N2, EventLimRepeat$)
  358.     CALL Myd2(CurrentEventLine$, N3, N1, LimSep$)
  359.     CALL Myd2(CurrentEventLine$, N4, N3, EventRepeat$)
  360.     CALL Myd2(CurrentEventLine$, N7, N1, Blank1$)
  361.     CALL Myd2(CurrentEventLine$, N8, N2, EventMonth$)
  362.     CALL Myd2(CurrentEventLine$, N10, N1, Hyphen$)
  363.     CALL Myd2(CurrentEventLine$, N11, N2, EventDay$)
  364.     CALL Myd2(CurrentEventLine$, N13, N1, Hyphen$)
  365.     CALL Myd2(CurrentEventLine$, N14, N2, EventYear$)
  366.     CALL Myd2(CurrentEventLine$, N16, N1, Blank1$)
  367.     CALL Myd2(CurrentEventLine$, N17, N3, ScreenTag$)
  368.     CALL Myd2(CurrentEventLine$, N20, N1, Blank1$)
  369.     CALL Myd2(CurrentEventLine$, N21, N2, EventHour$)
  370.     CALL Myd2(CurrentEventLine$, N23, N1, ":")
  371.     CALL Myd2(CurrentEventLine$, N24, N2, EventMinute$)
  372.     CALL Myd2(CurrentEventLine$, N26, N2, Blank2$)
  373.     CALL Myd2(CurrentEventLine$, N28, TextSize, EventText$)
  374. ExitPoint0:
  375.         Subnum = SubnumSave
  376.     END SUB
  377.     '=========================================================================
  378.     SUB CheckDate (DateToValidate$) STATIC
  379.     '=========================================================================
  380.     DEFINT A-Z
  381.         SubnumSave = Subnum
  382.         Subnum = 8
  383.     '  Check Date For Validity
  384.     '  Input  DateToValidate$ (YYYYMMDDHHMM)
  385.     '  Output DateValidation   0 or 1 (Error)
  386.     DateValidation = N0
  387.     ReturnMessage$ = Blank0$
  388.     '           Check Date/Time
  389.     IF MID$(DateToValidate$, N1, 8) = Blank8$ THEN 
  390.         CALL Myd2(DateToValidate$, N1, N8, TodaysDate$)
  391.     END IF
  392.     '           Date
  393.     IF MID$(DateToValidate$, 9, 4) = SPACE$(4) THEN 
  394.         CALL Myd2(DateToValidate$, N9, N4, CurrentTime$)
  395.     END IF
  396.     '           Time
  397.     IF NumberError(DateToValidate$) = N1 THEN
  398.         ReturnMessage$ = "Non-Numeric Date"
  399.         GOTO DateBad
  400.     END IF
  401.     '           Numerics
  402.     ValidateYear = VAL(MID$(DateToValidate$, N1, 4))
  403.     FOR I = N1 TO 4
  404.         '           Y,M,D,H,M
  405.         DateEdit(I) = VAL(MID$(DateToValidate$, I * N2 + N3, N2))
  406.         '           Numeric
  407.         IF I < N3 AND DateEdit(I) <= N0 THEN
  408.             ReturnMessage$ = "Non-Positive Date"
  409.             GOTO DateBad
  410.         END IF
  411.         IF I > N2 AND DateEdit(I) <= Nm1 THEN
  412.             ReturnMessage$ = "Negative Date"
  413.             GOTO DateBad
  414.         END IF
  415.         IF I <> N2 THEN
  416.             ' Days In Month
  417.             IF DateEdit(I) > DateEditLimits(I) THEN
  418.                 ReturnMessage$ = "Date Too Large"
  419.                 GOTO DateBad
  420.               ELSE
  421.                 GOTO NextDatePart
  422.             END IF
  423.         END IF
  424.         IF DateEdit(N1) <> N2 OR DateEdit(N2) <> 29 THEN
  425.             ' February 29th
  426.             IF DateEdit(N2) > MonthLength(DateEdit(N1)) THEN
  427.                 ReturnMessage$ = "Date Too Large"
  428.                 GOTO DateBad
  429.               ELSE
  430.                 GOTO NextDatePart
  431.             END IF
  432.         END IF
  433.         '           Days In Month
  434.         IF NOT Leap(ValidateYear) THEN
  435.             ReturnMessage$ = "Not Leap Year"
  436.             GOTO DateBad
  437.         END IF
  438.         '           Leap Year
  439. NextDatePart:
  440.     NEXT
  441.     GOTO ExitPoint2
  442.     '           Ok
  443. DateBad:
  444.     DateValidation = N1
  445.     '           Error
  446. ExitPoint2:
  447.         Subnum = SubnumSave
  448.     END SUB
  449.     '=========================================================================
  450.     SUB ClearLast3 STATIC
  451.     '=========================================================================
  452.     DEFINT A-Z
  453.         SubnumSave = Subnum
  454.         Subnum = 9
  455.     CALL ShowMult(N0, N23, N1, N80, N3)
  456.         Subnum = SubnumSave
  457.     END SUB
  458.     '=========================================================================
  459.     SUB ClearLast4 STATIC
  460.     '=========================================================================
  461.     DEFINT A-Z
  462.         SubnumSave = Subnum
  463.         Subnum = 10
  464.     CALL ShowMult(N0, N22, N1, N80, N4)
  465.         Subnum = SubnumSave
  466.     END SUB
  467.     '=========================================================================
  468.     SUB ClearOverdueTable STATIC
  469.     '=========================================================================
  470.     DEFINT A-Z
  471.         SubnumSave = Subnum
  472.         Subnum = 11
  473.     '     Clear Overdue Event Table
  474.     CLOSE FilenumOverdue
  475.     CALL KillAFile(ApptFilenameOverdue$)
  476.     OverdueCount = N0
  477.     RedisplayCalendars = Yes
  478.         Subnum = SubnumSave
  479.     END SUB
  480.     '=========================================================================
  481.     SUB ClearScreenNormal (ClearTimerDesired) STATIC
  482.     '=========================================================================
  483.     DEFINT A-Z
  484.         SubnumSave = Subnum
  485.         Subnum = 12
  486.     CALL Kolors(N6)
  487.     CLS
  488.     TimerDesired = ClearTimerDesired
  489.     IF TimerDesired THEN
  490.         TimerDisplaySuppress = No
  491.         CALL KeyStuff(KeyTimerInit)        ' Show Timer & State Flags
  492.         CALL DisplayApptFilename           '  & appt file name if one
  493.       ELSE
  494.         TimerDisplaySuppress = Yes
  495.     END IF
  496.         Subnum = SubnumSave
  497.     END SUB
  498.     '=========================================================================
  499.     SUB CloseFiles STATIC
  500.     '=========================================================================
  501.     DEFINT A-Z
  502.         SubnumSave = Subnum
  503.         Subnum = 13
  504.     CLOSE
  505.     ApptFile = No
  506.         Subnum = SubnumSave
  507.     END SUB
  508.     '=========================================================================
  509.     SUB ColorDecode (CDColorAttribute)  STATIC
  510.     '=========================================================================
  511.     DEFINT A-Z
  512.         SubnumSave = Subnum
  513.         Subnum = 14
  514.     '  Given a color attribute, find the foreground and background colors
  515.     ColorBackground = (CDColorAttribute - (CDColorAttribute AND 128)) \ 16
  516.     ColorForeground = (CDColorAttribute - _
  517.                     (CDColorAttribute AND 128)) MOD 16 + _
  518.                     (CDColorAttribute AND 128) \ 8
  519.         Subnum = SubnumSave
  520.     END SUB
  521.     '=========================================================================
  522.     SUB CombineDateTime STATIC
  523.     '=========================================================================
  524.     DEFINT A-Z
  525.         SubnumSave = Subnum
  526.         Subnum = 15
  527.     CALL Myd2(EventDate$, N1, N2, EventYear1st2$)
  528.     CALL Myd2(EventDate$, N3, N2, EventYear$)
  529.     CALL Myd2(EventDate$, N5, N2, EventMonth$)
  530.     CALL Myd2(EventDate$, N7, N2, EventDay$)
  531.     CALL Myd2(EventTime$, N1, N2, EventHour$)
  532.     CALL Myd2(EventTime$, N3, N2, EventMinute$)
  533.     CALL Myd2(EventDateTime$, N1, N8, EventDate$)
  534.     CALL Myd2(EventDateTime$, N9, N4, EventTime$)
  535.     CombinedDateTime# = VAL(EventDateTime$)
  536.         Subnum = SubnumSave
  537.     END SUB
  538.     '=========================================================================
  539.     SUB CompressApptFile (ShrinkNumber) STATIC
  540.     '=========================================================================
  541.     '  Compress Appointment File By ShrinkNumber Records From the End
  542.     '  Delete Blank or Duplicate History Records in the Process
  543.     DEFINT A-Z
  544.         SubnumSave = Subnum
  545.         Subnum = 104
  546.     CALL ShowErase(N14, N25, N1, N80, _
  547.         "       Please Wait--Compressing Appointment File")
  548.     InputEOF = LOF(FilenumAppt) \ N80
  549.     '     By Opening A New Appointment File ApptFilename$.cln
  550.     '     And Copying The Old File To The New One
  551.     CALL KillAFile(ApptFilename$ + ".cln")
  552.     OutputIndex = N1
  553.     CLOSE FilenumNewAppt
  554.     OPEN "R", FilenumNewAppt, ApptFilename$ + ".cln", N80
  555.     FIELD FilenumNewAppt, N80 AS NewApptBuffer$
  556.     '  Loop through File to Move Records
  557.     FOR InputIndex = N1 TO InputEOF - ShrinkNumber
  558.       CALL KeyStuff(KeyStatus)
  559.       CALL ShowIt(N14, N25, N49, (STR$(InputEOF - ShrinkNumber - _
  560.         InputIndex + N1) + SPACE$(N4))) ' Count
  561.       CALL GetApptRecord(InputIndex)             ' Next Record
  562.       IF (InputIndex < StartingHistory) OR (ApptBuffer$ <> Blank80$ AND _
  563.          ApptBufferHold$ <> ApptBuffer$ AND _
  564.          ApptBuffer$ <> NullEvent$ AND _
  565.          ApptBuffer$ <> NullEventOld$)        THEN
  566.            '   Move Record To Output
  567.            CALL MhLset(NewApptBuffer$, ApptBuffer$)
  568.            PUT FilenumNewAppt, OutputIndex           ' Write to New File
  569.            ' Save for Next Comparison
  570.            ApptBufferHold$ = ApptBuffer$
  571.            OutputIndex = OutputIndex + N1        ' Bump Record Counter
  572.       END IF
  573.       IF (InputIndex - StartingHistory + N1) = (CurrentNoteHist) THEN
  574.       '  Set New History Pointer
  575.         CurrentNoteHist = OutputIndex - StartingHistory + N1
  576.       END IF
  577.     NEXT
  578.     '  Then Deleting The Old One,
  579.     '    Renaming The New One ApptFilename$.cld
  580.     '       And Reopening It As The Appointment File--Magic!
  581.     CALL CloseFiles
  582.     CALL KillAFile(ApptFilename$ + ".cld")
  583.     CALL MhRename ((ASCIIZ$(ApptFilename$ + ".cln")), _
  584.             (ASCIIZ$(ApptFilename$ + ".cld")), Ecode%)
  585.         IF Ecode THEN ERROR 255
  586.     CALL OpenAppts
  587.         Subnum = SubnumSave
  588.     END SUB
  589.     '=========================================================================
  590.     SUB ComputePendingValue (AlarmValue#, PendingValue#) STATIC
  591.     '=========================================================================
  592.     '   Get Date/Time Subtracting Minutes Value (For Pending Function)
  593.     '   Input is AlarmValue# (YYYYMMDDTTTT), Return is PendingValue# (Same)
  594.     '=========================================================================
  595.     DEFINT A-Z
  596.         SubnumSave = Subnum
  597.         Subnum = 16
  598.     '   Break Down AlarmValue Into Parts
  599.     PendingString$ = RIGHT$(STR$(AlarmValue#), 12)
  600.     PendingYear = VAL(MID$(PendingString$, N1, 4))
  601.     PendingMonth = VAL(MID$(PendingString$, 5, N2))
  602.     PendingDay = VAL(MID$(PendingString$, N7, N2))
  603.     PendingHours = VAL(MID$(PendingString$, 9, N2))
  604.     PendingMinutes = VAL(MID$(PendingString$, 11, N2))
  605.     '  Test if enough minutes left to subtract Pending
  606. TestMinutes:
  607.     IF PendingMinutes >= Pending THEN
  608.         PendingMinutes = PendingMinutes - Pending
  609.         GOTO RebuildDate
  610.     END IF
  611.     '  Not enough minutes, try hours
  612. TestHours:
  613.     IF PendingHours > N0 THEN
  614.         PendingHours = PendingHours - N1
  615.         PendingMinutes = PendingMinutes + 60
  616.         GOTO TestMinutes
  617.     END IF
  618.     '  Not enough hours, try days
  619. TestDays:
  620.     IF PendingDay > N1 THEN
  621.         PendingDay = PendingDay - N1
  622.         PendingHours = PendingHours + 24
  623.         GOTO TestHours
  624.     END IF
  625.     '  Not enough days, try months, (check for leap year if feb)
  626. TestMonths:
  627.     IF PendingMonth > N1 THEN
  628.         PendingMonth = PendingMonth - N1
  629.         PendingDay = PendingDay + MonthLength(PendingMonth)
  630.         IF PendingMonth <> N2 THEN GOTO TestDays
  631.           PendingDay = PendingDay + Leap(PendingYear)
  632.           GOTO TestDays
  633.     END IF
  634.     '  Not enough years, subtract one
  635.     PendingYear = PendingYear - N1
  636.     PendingMonth = PendingMonth + 12
  637.     GOTO TestMonths
  638.     '  Put the value back together - no blanks
  639. RebuildDate:
  640.     CALL YearAdjust(PendingYear, AdjustedYear$)
  641.     PendingString$ = ZeroFill$(AdjustedYear$ + RIGHT$(STR$(PendingMonth), _
  642.         N2) + RIGHT$(STR$(PendingDay), N2) + RIGHT$(STR$(PendingHours), _
  643.         N2) + RIGHT$(STR$(PendingMinutes), N2))
  644.     PendingValue# = VAL(PendingString$)
  645.         Subnum = SubnumSave
  646.     END SUB
  647.     '=========================================================================
  648.     SUB ControlledInput (CBoxRow, CBoxColumn, CMessageRow, _
  649.         CMessageColumn, CLength, CMessageText$, CInputResponse$, _
  650.         NumlockRequest, CFilenameShow, CScreenBottomsShow, CHoldAtEnd) STATIC
  651.     '=========================================================================
  652.     '   Accept Input, Given Location, Length, Prompt Message
  653.     DEFINT A-Z
  654.         SubnumSave = Subnum
  655.         Subnum = 17
  656.     '-------------------------------------------------------------------------
  657.     '         Input/Output Call Parameters
  658.     '  BoxRow,BoxColumn             Placement Of Editing Field
  659.     '  MessageRow,MessageColumn     Placement Of Prompt Message
  660.     '  MessageText$                 Prompt Message
  661.     '  Length                       Length Of Prompt Message
  662.     '  InputResponse$               Returned Response (in Common)
  663.     '  HoldAtEnd                    Hold Cursor at End Input
  664.     '  NumlockRequest               Change Value of Numlock (1=on, 0=off)
  665.     '  FilenameShow                 Display Appointment Filename
  666.     '  ScreenBottomsShow            Display Screen Bottom Prompts
  667.     BoxRow = CBoxRow
  668.     BoxColumn = CBoxColumn
  669.     MessageRow = CMessageRow
  670.     MessageColumn = CMessageColumn
  671.     Length = CLength
  672.     MessageText$ = CMessageText$
  673.     FilenameShow = CFilenameShow
  674.     ScreenBottomsShow = CScreenBottomsShow
  675.     HoldAtEnd = CHoldAtEnd
  676.     InputResponse$ = CInputResponse$
  677.     '-------------------------------------------------------------------------
  678.     '     Display Box For Input Value To Be Placed In
  679.     IF NumlockRequest THEN                  ' This will automatically
  680.         CALL KeyStuff(KeyNumOn)            '  turn Insert off until
  681.       ELSE                                  '  allowed
  682.         CALL KeyStuff(KeyNumOff)
  683.     END IF
  684.     AllowInsertMode = Yes
  685.     IF FilenameShow THEN CALL DisplayApptFilename
  686.     IF ScreenBottomsShow THEN CALL ScreenBottoms
  687.     InLength = LEN(InputResponse$)
  688.     IF InLength < Length THEN               ' Pad out if too short
  689.         InputResponse$ = InputResponse$ + SPACE$(Length - InLength)
  690.     END IF
  691.     IF InLength > Length THEN               '   or chop off if too long
  692.         InputResponse$ = LEFT$(InputResponse$, Length)
  693.     END IF
  694.     '  Establish the Box
  695.     CALL ShowIt(N14, BoxRow, BoxColumn, (SPACE$(Length)))
  696.     '-------------------------------------------------------------------------
  697.     '     Display The Initial Value Of Input And Prompt Message
  698.     IF NOT EchoSuppression THEN
  699.         CALL ShowIt(N0, N0, N0, InputResponse$)
  700.       ELSE
  701.         ' Blanks
  702.         CALL ShowIt(N0, N0, N0, (Strng$(LEN(InputResponse$), N32))) 
  703.     END IF
  704.     CALL ShowIt(N6, MessageRow, MessageColumn, MessageText$)
  705.     '-------------------------------------------------------------------------
  706.     '     Place The Cursor, Set Character Position (J)
  707.     CALL Kolors(N14)
  708.     CursorRow = BoxRow
  709.     CursorColumn = BoxColumn
  710.     CALL KeyStuff(KeyCursor)           ' Turn the cursor on
  711.     J = N1
  712.     '-------------------------------------------------------------------------
  713.     ' Special Editing Keys
  714.     '    Shift-Tab     Goes To Left End Of Editing Field
  715.     '    Shift-Return  Goes To Right End Of Editing Field
  716.     '    Shift-Delete  Deletes Rest Of Editing Field From Cursor To End
  717.     '=========================================================================
  718.     '  Next Keystroke Comes Back to Here
  719.     '=========================================================================
  720. WordStart:
  721.     DisplayWholeWord$ = False$         'Whole Word Instead of 1 Character
  722.     CursorIncremented = N0              'Cursor Moved After Character
  723.     IncrementCursor$ = False$          'Request to Move Cursor Right
  724.     NormalKeystroke$ = False$          'Character Entered Flag
  725.     '=========================================================================
  726. KeyGet:
  727.     KeyTrapEnabled = Yes          'Enable Editing Key Trap
  728.     CALL KeyStuff(KeySingle)      'Move the Cursor/Get a Keystroke
  729.     KeyTrapEnabled = No           'Disable Editing Key Trap
  730.     '=========================================================================
  731.     SELECT CASE KeyShiftTrap           ' Special Key Traps From Main Level
  732.         CASE 0                             'None (0)
  733.             CALL Kolors(N14)
  734.             SELECT CASE LEN(Keystroke$) + N1'Regular Keystrokes
  735.                 CASE 1                             'No Keystroke
  736.                     GOTO KeyGet
  737.                 CASE 2                             'Length One Keys
  738.                     GOTO OneKeys
  739.                 CASE 3                             'Length Two Keys
  740.                     GOTO TwoKeys
  741.             END SELECT
  742.         CASE 2                             'Shift Tab (2)
  743.             '---------------------------------------------------------------
  744.             '     Shift-Tab Goes To Left End Of Editing Field (also home)
  745.             KeyShiftTrap = N0
  746. LeftEndOfField:
  747.             J = N1
  748.             CursorRow = BoxRow
  749.             CursorColumn = BoxColumn + J - N1
  750.             GOTO WordStart
  751.         CASE 3                             'Shift Return (3)
  752.             '---------------------------------------------------------------
  753.             '     Shift-Return  Goes To Right End Of Editing Field (also end)
  754.             KeyShiftTrap = N0
  755. RightEndOfField:
  756.             J = Length
  757.             CursorRow = BoxRow
  758.             CursorColumn = BoxColumn + J - N1
  759.             GOTO WordStart
  760.         CASE 4                             'Shift Delete (4)
  761.             '---------------------------------------------------------------
  762.             ' Shift-Delete  Deletes Rest Of Editing Field From Cursor To End
  763.             KeyShiftTrap = N0
  764.             CALL Myd2(InputResponse$, J, Length - J + N1, _
  765.                 (Strng$(Length - J + N1, N32)))
  766.             DisplayWholeWord$ = True$
  767.             IncrementCursor$ = False$
  768.             GOTO NewCharWholeWord
  769.         CASE 5                             'Ctrl-Right-Arrow (5)
  770.             '---------------------------------------------------------------
  771.             '     Ctrl-Right-Arrow Goes to Next Word
  772.             KeyShiftTrap = N0
  773.             IF MID$(InputResponse$, J, N1) = Blank1$ THEN  'Next Non-Blank
  774.                 CALL MhNotInstr(Pointer%, J%, InputResponse$, N32)
  775.                 IF Pointer THEN J = Pointer             'If Was Blank
  776.               ELSE
  777.                 CALL MhInstr(Pointer%, J%, InputResponse$, Blank1$)
  778.                 IF Pointer <> N0 AND Pointer <> Length THEN 'Next Blank
  779.                     CALL MhNotInstr(Pointer%, (Pointer% + N1%), _
  780.                         InputResponse$, 32)                'Then Next
  781.                     IF Pointer THEN J = Pointer            'Non-Blank
  782.                 END IF
  783.             END IF
  784.             CursorRow = BoxRow
  785.             CursorColumn = BoxColumn + J - N1
  786.             GOTO WordStart
  787.         CASE 6                             'Ctrl-Left-Arrow (6)
  788.             '---------------------------------------------------------------
  789.             '     Ctrl-Left-Arrow Goes to Previous Word
  790.             FirstNonBlankChar = No
  791.             KeyShiftTrap = N0
  792.             FromRightEnd = Length - J + N1     ' From Right End, Not Left
  793.                                         ' Find Last non blk
  794.             IF MID$(InputResponse$, J, N1) = Blank1$ THEN  
  795. NowDoBlank:
  796.                 CALL MhNotBackwardInstr(Pointer%, FromRightEnd%, _
  797.                     InputResponse$, N32)
  798.                 IF Pointer < N2 OR FirstNonBlankChar = Yes THEN
  799.                     IF Pointer <> N0 THEN 
  800.                         J = Pointer 
  801.                       ELSE 
  802.                         J = N1
  803.                     END IF
  804.                     GOTO PrevWordDone
  805.                 END IF
  806.                 FromRightEnd = Length - Pointer + N1
  807.             END IF
  808.             CALL MhBackwardInstr(Pointer%, FromRightEnd%, _
  809.                     InputResponse$, Blank1$)         ' to next blank
  810.             SELECT CASE Pointer
  811.                 CASE 0
  812.                     J = N1
  813.                 CASE IS = (J - N1)
  814.                     IF FirstNonBlankChar THEN GOTO CaseElse
  815.                         FirstNonBlankChar = Yes
  816.                         FromRightEnd = FromRightEnd + N1
  817.                         GOTO NowDoBlank
  818.                 CASE ELSE
  819. CaseElse:
  820.                     J = Pointer + N1
  821.             END SELECT
  822. PrevWordDone:
  823.             CursorRow = BoxRow
  824.             CursorColumn = BoxColumn + J - N1
  825.             GOTO WordStart
  826.     END SELECT
  827.     '=========================================================================
  828.     '     Length One Keys--Take Action
  829.     '=========================================================================
  830. OneKeys:
  831.     SELECT CASE InString(CHR$(Enter) + CHR$(Tabb) + CHR$(Bsp) + CHR$(Esc), _
  832.                 RIGHT$(Keystroke$, N1))
  833.         CASE 1, 2, 4                  'Enter, Tab, Esc Keys (Exits)
  834.             GOTO WordOut
  835.         CASE 3                        'Back Space Key (Deletes Prev Char)
  836.             '---------------------------------------------------------------
  837.             'Backspace, If Beginning, Sound Bell, Otherwise Delete Char Left
  838.             IF J = N1 THEN
  839.                 CALL MinorBeeper
  840.                 GOTO WordStart
  841.             END IF
  842.             J = J - N1
  843.             CALL Myd2(InputResponse$, J, N1, Blank1$)
  844.             IncrementCursor$ = False$
  845.             IF Insrt% = N1 THEN      ' If Insert Mode
  846.                 GOSUB ShiftLeft          ' Move String After Character
  847.               ELSE
  848.                 DisplayWholeWord$ = False$' Else Delete Only Character
  849.             END IF
  850.             GOTO NewCharWholeWord
  851.         CASE ELSE                     'Other Length One Keys (Normal Input)
  852.             '---------------------------------------------------------------
  853.             ' Other Input Keys, Save Keystroke In Current Character Position
  854.             '  If Insert Mode is On, Move String Right As Character Types
  855.             IF Insrt% = N1 THEN
  856.                 GOSUB ShiftRight
  857.                 DisplayWholeWord$ = True$
  858.               ELSE
  859.                 DisplayWholeWord$ = False$
  860.             END IF
  861.             CALL Myd2(InputResponse$, J, N1, Keystroke$)
  862.             IncrementCursor$ = True$
  863.             NormalKeystroke$ = True$
  864.             GOTO NewCharWholeWord
  865.     END SELECT
  866.     '=========================================================================
  867.     '     Length Two Keys--Take Action
  868.     '=========================================================================
  869. TwoKeys:
  870.     SELECT CASE InString(CHR$(F1) + CHR$(West) + CHR$(East) + CHR$(Del) + _
  871.                         CHR$(HomeKey) + CHR$(EndKey), RIGHT$(Keystroke$, N1))
  872.         CASE 1                        'F1 (Exits)
  873.             GOTO WordOut
  874.         CASE 2                        'West (Cursor Left)
  875.             '---------------------------------------------------------------
  876.             '     West Moves Cursor Left One
  877.             IF J = N1 THEN
  878.                 CALL MinorBeeper
  879.               ELSE
  880.                 J = J - N1
  881.                 CursorRow = BoxRow
  882.                 CursorColumn = BoxColumn + J - N1
  883.             END IF
  884.             GOTO WordStart
  885.         CASE 3                        'East (Cursor Right)
  886.             '---------------------------------------------------------------
  887.             '     East Moves Cursor Right One
  888.             IF J = Length THEN
  889.                 CALL MinorBeeper
  890.               ELSE
  891.                 J = J + N1
  892.                 CursorRow = BoxRow
  893.                 CursorColumn = BoxColumn + J - N1
  894.             END IF
  895.             GOTO WordStart
  896.         CASE 4                        'Delete (String Left)
  897.             '---------------------------------------------------------------
  898.             '     Delete Moves Whole String Left One, Trailing A Space
  899.             GOSUB ShiftLeft
  900.             GOTO NewCharWholeWord
  901.         CASE 5                    'Home (same as shift-tab)
  902.             '---------------------------------------------------------------
  903.             GOTO LeftEndOfField
  904.         CASE 6                    'End  (same as shift-return)
  905.             '---------------------------------------------------------------
  906.             GOTO RightEndOfField
  907.         CASE ELSE                     'Error -- get another keystroke
  908.             '---------------------------------------------------------------
  909.             CALL MinorBeeper
  910.             GOTO WordStart
  911.     END SELECT
  912.     '=========================================================================
  913.     '  New Character or Whole Word Display Comes Here
  914.     '=========================================================================
  915. NewCharWholeWord:
  916.     IF DisplayWholeWord$ = True$ THEN
  917.         GOSUB WordShow                              'Display Whole Word
  918.         DisplayWholeWord$ = False$
  919.       ELSE                                            'or
  920.         IF NOT EchoSuppression THEN
  921.             CALL ShowIt(N0, BoxRow, (BoxColumn + J - N1), _
  922.                 (MID$(InputResponse$, J, N1)))   'Just One Character
  923.           ELSE                                       'or
  924.             CALL ShowIt(N0, BoxRow, (BoxColumn + J - N1), Blank1$)
  925.     '                                             Blank if Suppressed
  926.         END IF
  927.     END IF
  928.     '-------------------------------------------------------------------------
  929.     IF IncrementCursor$ = True$ THEN
  930.         IF J < Length THEN                 'Move Cursor, Don't Overrun Field
  931.             CursorIncremented = N1
  932.             J = J + N1
  933.           ELSE
  934.             CursorIncremented = N0
  935.         END IF
  936.     END IF
  937.     '-------------------------------------------------------------------------
  938.     '  Place The Cursor In Its New Position
  939.     CursorRow = BoxRow
  940.     CursorColumn = BoxColumn + J - N1
  941.     '-------------------------------------------------------------------------
  942.     '  Get Next Keystroke If Any Of The Following ---
  943.     IF HoldAtEnd OR J < Length OR NormalKeystroke$ = False$ OR _
  944.         (NormalKeystroke$ = True$ AND CursorIncremented = N1)         THEN
  945.         GOTO WordStart
  946.     END IF                    '  Character at end of field gets out
  947.     '=========================================================================
  948.     '  Get Out Here -- We're Finished
  949.     '=========================================================================
  950.     '     No hold, F1, Enter, Tab, And Escape End It All
  951. WordOut:
  952.     CALL Kolors(N7)
  953.     GOSUB WordShow                         '  At End, Display Whole Word
  954.     CALL Kolors(N6)
  955.     GOTO Finished
  956.     '-------------------------------------------------------------------------
  957.     '     Reprint Entire Input Word And Reposition Cursor Where It Was
  958. WordShow:
  959.     IF NOT EchoSuppression THEN
  960.         CALL ShowIt(N0, BoxRow, BoxColumn, InputResponse$)
  961.       ELSE
  962.         CALL ShowIt(N0, BoxRow, BoxColumn, _
  963.             (Strng$(LEN(InputResponse$), N32)))
  964.     END IF
  965.     RETURN
  966.     '---------------------------------------------------------------
  967.     'Insert Mode Moves Whole String Right One, Truncating, Inserts Space
  968. ShiftRight:
  969.     IF J <> Length THEN 
  970.         MID$(InputResponse$, J + N1, Length - J) = _  'MhMidString made all
  971.             MID$(InputResponse$, J, Length - J)      ' the characters the
  972.     END IF                                      ' same as the 1st
  973.     CALL Myd2(InputResponse$, J, N1, Blank1$)
  974.     RETURN
  975.     '---------------------------------------------------------------
  976.     'Delete Moves Whole String Left One, Trails with Space
  977. ShiftLeft:
  978.     IF J <> Length THEN 
  979.         CALL MhMidString(InputResponse$, J%, Length% - J%, _
  980.             InputResponse$, J% + N1%)
  981.     END IF
  982.     CALL Myd2(InputResponse$, Length, N1, Blank1$)
  983.     DisplayWholeWord$ = True$
  984.     IncrementCursor$ = False$
  985.     RETURN
  986.     '-------------------------------------------------------------------------
  987. Finished:
  988.     CInputResponse$ = InputResponse$
  989.     AllowInsertMode = No
  990.     CALL KeyStuff(KeyCursorOff)        '  Turn Cursor Off
  991.     CALL KeyStuff(KeyNumOff)           '  Turn Numlock Off
  992.     IF ScreenBottomsShow THEN CALL ScreenBottomsDelete
  993.         Subnum = SubnumSave
  994.     END SUB
  995.     '=========================================================================
  996.     SUB Credits (WhichLine)  STATIC
  997.     '=========================================================================
  998.     '   Phone Number, Address, Registration Fee or Owner
  999.     '    Used by GenGreeting1 and EndItAll
  1000.     DEFINT A-Z
  1001.         SubnumSave = Subnum
  1002.         Subnum = 139
  1003.     AddressLine = WhichLine + N1
  1004.     BoxEnd = WhichLine + N4
  1005.     CopyLine = WhichLine + N5
  1006.     IF ColorCRT THEN CALL Kolors(N3) ELSE CALL Kolors(N7)
  1007.     CALL BoxDraw(N1, WhichLine, BoxEnd, N8, N38)
  1008.     CALL BoxDraw(N1, WhichLine, BoxEnd, N48, N72)
  1009.     CALL ShowMult(N6, AddressLine, N9, N29, N3)
  1010.     CALL ShowMult(N6, AddressLine, N49, N23, N3)
  1011.     CALL ShowIt(N6, AddressLine, N10, "11645 Charter Oak Ct., #201")
  1012.     CALL ShowIt(N0, Nm1, N13, "Reston, VA  22090-4526")
  1013.     CALL ShowIt(N0, Nm1, N16, "(703)  435-1110")
  1014.     CALL ValidateUser (WhichLine)
  1015.     IF ColorCRT THEN CALL Kolors(N4) ELSE CALL Kolors(N7)
  1016.     CALL ShowIt(N0, CopyLine, Nm2, _
  1017.    " Copyright (c) 1985-1990 by Paul Muñoz-Colman.  All rights reserved. ")
  1018.         Subnum = SubnumSave
  1019.     END SUB
  1020.     '=========================================================================
  1021.     SUB DayDate (DateToIndex$)  STATIC
  1022.     '=========================================================================
  1023.     '   Find The Day Of The Week For A Date (DayDate)
  1024.     '     (DateToIndex$ in gives IndexedDay out)
  1025.     '    Good from Years 0001 to 9999
  1026.     DEFINT A-Z
  1027.         SubnumSave = Subnum
  1028.         Subnum = 18
  1029.     '-------------------------------------------------------------------------
  1030.     '  Appreciation to Herb Goertzel for his simple and brilliant piece of
  1031.     '  mathematics.  Day of week is number of years (residues; 365 Mod 7 = One)
  1032.     '  plus leap year days plus current year days, modulo 7, plus 1.
  1033.     '-------------------------------------------------------------------------
  1034.     Year = VAL(MID$(DateToIndex$, N1, 4))                 'The Year
  1035.     Month = VAL(MID$(DateToIndex$, 5, N2))                'The Month
  1036.     Day = VAL(MID$(DateToIndex$, N7, N2))                  'The Day
  1037.     '-------------------------------------------------------------------------
  1038.     '  For The Current Year, Count Leap Year Day If Necessary
  1039.     '  If This Isn't A Leap Year or Before March, Don't Count Leap Year Day
  1040.     '  If Before March Don't Count Feb 29th Because It's Included in "Day"
  1041.     IF Month < N3 THEN
  1042.             LeapYearDay = N0    'Then don't count leap year
  1043.         ELSE
  1044.             LeapYearDay = Leap(Year)   'Else count it
  1045.     END IF
  1046.     '-------------------------------------------------------------------------
  1047.     '  Now Count The Number of Year Residues and Add In Past Leap Year Days
  1048.     Prioryears = Year - N1
  1049.     PriorYearsWLeaps = Prioryears + INT(Prioryears / 4) + _
  1050.         INT(Prioryears / 400) - INT(Prioryears / 100)  '  - Every 100th Year
  1051.     PriorYearsLeaps = PriorYearsWLeaps - Prioryears     '   except 400th
  1052.     PriorYearsDays& = Prioryears * 365&
  1053.     '-------------------------------------------------------------------------
  1054.     '  Now Add the Days This Year Into The Total (Also Do The Julian Date)
  1055.     '  Total   = Residue  +  Prior Months + This Month + Leap Year
  1056.     AllWLeaps = PriorYearsWLeaps + JulianDays(Month) + Day + LeapYearDay
  1057.     JulianDate& = AllWLeaps - PriorYearsWLeaps + 1000& * (Year MOD 100)
  1058.     '-------------------------------------------------------------------------
  1059.     '   Take The Whole Thing Modulo 7 and Make Non-Zero
  1060.     '  (If the calendar had started in the year 0000, Jan 1, 0000 would
  1061.     '   arithmetically have been a Saturday!)
  1062.     IndexedDay = N1 + AllWLeaps MOD N7
  1063.     CountedDay& = AllWLeaps - Prioryears + 365 + PriorYearsDays&
  1064.     '-------------------------------------------------------------------------
  1065.     IF Year = N0 AND Month = N1 AND Day = N1 THEN
  1066.         IndexedDay = N7
  1067.         JulianDate& = N1
  1068.         CountedDay& = N0
  1069.     END IF
  1070.     '-------------------------------------------------------------------------
  1071.         Subnum = SubnumSave
  1072.     END SUB
  1073.     '=========================================================================
  1074.     FUNCTION DirectoryExist(DirectoryName$)  STATIC
  1075.     '=========================================================================
  1076.     '  To See if a Directory Exists -- Using MhDir & MhDirExist
  1077.     DEFINT A-Z
  1078.         SubnumSave = Subnum
  1079.         Subnum = 142
  1080.     IF LEN(DirectoryName$) = N3 AND MID$(DirectoryName$,N2) = ":\" THEN
  1081.            Drive = ASC(DirectoryName$) - N64            'If root, then
  1082.            Temp$ = SPACE$(66)                        'can't use 
  1083.            CALL MhDir(N1%, Drive%, Temp$, NoSuchDir%)     'MhDirExist
  1084.            Temp$ = Blank0$
  1085.       ELSE
  1086.         CALL MhDirExist((ASCIIZ$(DirectoryName$)), NoSuchDir%)
  1087.     END IF
  1088.     IF NoSuchDir THEN
  1089.         DirectoryExist = No
  1090.       ELSE
  1091.         DirectoryExist = Yes
  1092.     END IF
  1093.         Subnum = SubnumSave
  1094.     END FUNCTION
  1095.     '=========================================================================
  1096.     SUB DirectReturnCheck STATIC
  1097.     '=========================================================================
  1098.     '  To See If Event Table Is Stable When Returning To Main Menu
  1099.     '    So Prompt for Returning To Clock Screen Can Be Pressent
  1100.     DEFINT A-Z
  1101.         SubnumSave = Subnum
  1102.         Subnum = 19
  1103.     IF EventTableStable THEN
  1104.         DirectReturn = Yes
  1105.         Menu1 = MainMenuLastEntry
  1106.         IF NOT ApptFile THEN CALL OpenAppts
  1107.       ELSE
  1108.         DirectReturn = No
  1109.     END IF
  1110.         Subnum = SubnumSave
  1111.     END SUB
  1112.     '=========================================================================
  1113.     SUB DisplayApptFilename STATIC
  1114.     '=========================================================================
  1115.     '  Show the name of the Appointment File on the Menus
  1116.     DEFINT A-Z
  1117.         SubnumSave = Subnum
  1118.         Subnum = 20
  1119.     IF ApptFilename$ <> Blank8$ THEN
  1120.         CALL ShowIt(N13, N1, N64, " File ")
  1121.         CALL ShowIt(N6, N0, Nm1, (SPACE$(N10)))
  1122.         CALL ShowIt(N14, N0, N0, Blank1$)
  1123.         CALL GetFilenameLength
  1124.         CALL ShowIt(N0, N0, Nm1, _
  1125.             (MID$(ApptFilename$, N1, FilenameLength)))
  1126.         CALL ShowIt(N0, N0, Nm1, Blank1$)
  1127.     END IF
  1128.         Subnum = SubnumSave
  1129.     END SUB
  1130.     '=========================================================================
  1131.     SUB DOSBIOSServices  STATIC
  1132.     '=========================================================================
  1133.     DEFINT A-Z
  1134.         SubnumSave = Subnum
  1135.         Subnum = 138
  1136.     '  All DOS ROM BIOS Services come here
  1137.     '  All variables are in COMMON SHARED
  1138.     CALL MhDos2(DosEcode%, InterruptNumber%, _
  1139.         ES%, SI%, DI%, AH%, AL%, BH%, BL%, CH%, CL%, DH%, DL%)
  1140.     IF DosEcode% THEN
  1141.         ERROR 255
  1142.     END IF
  1143.         Subnum = SubnumSave
  1144.     END SUB
  1145.     '=========================================================================
  1146.     SUB DoShell (ShellCommand$) STATIC
  1147.     '=========================================================================
  1148.     '  All DOS Shells are Done From Here / Pass the Parameter /
  1149.     DEFINT A-Z
  1150.         SubnumSave = Subnum
  1151.         Subnum = 21
  1152.     CALL Kolors(N99)
  1153.     '  Ditch Trailing Blanks in Command
  1154.     ShellCommand$ = RTRIM$(ShellCommand$)
  1155.     IF MemoryResident THEN
  1156.         SrShellCommand$ = ShellCommand$
  1157.         ToShellCommand$ = ShellCommand$ + CHR$(N13%)
  1158.         CALL SrResidentShell(ToShellCommand$, ShellEcode%)
  1159.         IF ShellEcode THEN
  1160.             CALL SrCancelShell                 'Cancel Shell if Error
  1161.             Ecode = ShellEcode
  1162.             ERROR 254
  1163.           ELSE
  1164.             MemoryResidentShell = Yes
  1165.         END IF
  1166.         CALL StayResPopDown
  1167.         CALL SrCancelShell
  1168.         MemoryResidentShell = No
  1169.       ELSE
  1170.         CALL SetVideoMode(N1)
  1171.         CALL SetVideoPage(N1)
  1172.         CALL RestoreDOSKeyState            'Set DOS Ins,Caps,Num,Scroll
  1173.         LOCATE N3, N1, N1, InsertCursorStart, CursorStop' Set Cursor At Top
  1174.         CALL SetCurrentDirectory(N0)        ' Set User Directory
  1175.         IF ShellCommand$ <> Blank0$ THEN             ' Since Shell Won't
  1176.             SHELL (ShellCommand$)                   ' Turn it Off
  1177.           ELSE
  1178.             SHELL
  1179.         END IF
  1180.         CALL SaveCurrentDirectory(N0)       ' Save User Directory
  1181.         CALL SetCurrentDirectory(N1)        ' Set Calendar Directory
  1182.         CALL SaveDOSKeyState               'Save DOS Ins,Caps,Num,Scroll
  1183.         CALL SetVideoMode(N0)
  1184.         CALL SetVideoPage(N0)
  1185.         CALL RestoreCalKeyState            'Restore CAL Ins,Caps,Num,Scroll
  1186.     END IF
  1187.         Subnum = SubnumSave
  1188.     END SUB
  1189.     '=========================================================================
  1190.     SUB DOSShell (DOSEntry) STATIC
  1191.     '=========================================================================
  1192.     '  Run a Temporary DOS Session
  1193.     DEFINT A-Z
  1194.         SubnumSave = Subnum
  1195.         Subnum = 22
  1196.     CommandError$ = False$
  1197.     SELECT CASE DOSEntry
  1198.         CASE 0                        '  From Menu
  1199. BuildMenu:
  1200.             MenuLines(N1) = "Execute DOS Session and Return"
  1201.             MenuLines(N2) = "Execute Stored DOS Command and Return"
  1202.             MenuLines(N3) = "Change Stored DOS Command"
  1203.             ClockScreen = No
  1204.             OnEditPage = No
  1205.             CALL ClearScreenNormal(N1)
  1206.             ScreenTitles$(N1) = "Select Type of DOS Session to Execute"
  1207.             CALL Titles(N1)
  1208.             CALL ShowIt(N6, N12, N1, "Stored DOS Command Is --")
  1209.             IF DOSCommand$ = Blank80$ THEN
  1210.                 CALL ShowIt(N7, N13, N1, "(No Command Stored)")
  1211.               ELSE
  1212.                 CALL ShowIt(N7, N13, N1, DOSCommand$)
  1213.             END IF
  1214.             IF CommandError$ = True$ THEN
  1215.                 CALL PrepareforMessage
  1216.                 CALL ShowIt(N0, N0, N0, _
  1217.                     "DOS Command Is Blank -- Change If Desired")
  1218.                 CommandError$ = False$
  1219.                 DOSType = N3
  1220.             END IF
  1221.             CALL MenuDriver(N3, DOSType, N6, Nm1, No, N0, N1, N1)
  1222.             CALL BlankError
  1223.             IF MenuExit = MenuCancelled THEN
  1224.                 CALL ClearScreenNormal(N1)
  1225.                 CALL DirectReturnCheck
  1226.                 GOTO ExitPoint3
  1227.             END IF
  1228. PopCheckTime:
  1229.             IF DOSType <> N3 THEN
  1230.                 TimerDisplaySuppress = Yes
  1231.                 IF MemoryResident AND PoppedUpOverProgram THEN
  1232.                     ErrorLine1$ = _
  1233.     "Can't Execute DOS Session/Command If Loaded Before Another Program"
  1234.                     ERROR 253
  1235.                 END IF
  1236.                 CALL Kolors(N99)
  1237.                 CLS
  1238.             END IF
  1239.             SELECT CASE DOSType
  1240.                 CASE 1                        ' DOS Shell
  1241.                     IF NOT MemoryResident THEN
  1242.                         ScreenRow = N1
  1243.                         GOSUB ReturnPrep       ' Return Instructions
  1244.                         GOSUB Return2          ' Type Exit Instructions
  1245.                     END IF
  1246.                     CALL DoShell(Blank0$)    ' Go Do The DOS Session
  1247.                 CASE 2                        ' DOS Command
  1248.                     IF DOSCommand$ = Blank80$ THEN
  1249.                         CommandError$ = True$
  1250.                         GOTO BuildMenu
  1251.                     END IF
  1252.                     CALL DoShell(DOSCommand$)
  1253.                     IF NOT MemoryResident THEN
  1254.                         ScreenRow = N1
  1255.                         GOSUB ReturnPrep           ' Return Instructions
  1256.                         GOSUB ReturnPause          ' Pause Instructions
  1257.                     END IF
  1258.                 CASE 3                        ' Change DOS Command
  1259.                     CALL ControlledInput(N13, N1, N12, N1, N80, _
  1260.     "Enter DOS Command to Store Below --", DOSCommand$, N0, N1, N1, N1)
  1261.                     CALL WriteCalDOS
  1262.                     GOTO BuildMenu
  1263.             END SELECT
  1264.         CASE 1                        '  F6 For DOS Shell
  1265.             DOSType = N1
  1266.             GOTO PopCheckTime
  1267.         CASE 2                        '  F7 For DOS Command
  1268.             DOSType = N2
  1269.             GOTO PopCheckTime
  1270.     END SELECT
  1271.     CALL DirectReturnCheck
  1272.     CALL ClearScreenNormal(N1)
  1273.     GOTO ExitPoint3
  1274. ReturnPrep:
  1275.     ' Show Band for Instructions    
  1276.     CALL ShowErase(N13, N1, N1, N80, Blank0$)
  1277.     RETURN
  1278. ReturnPause:
  1279.     ' Issue Returning Instructions
  1280.     CALL ShowIt(N7, N1, Nm2, _
  1281.         " Press a Key to Return to Personal Calendar ... ")
  1282.     CALL KeyStuff(KeyWait)
  1283.     RETURN
  1284. Return2:
  1285.     ' Issue Pause Instructions and Wait
  1286.     CALL ShowIt(N7, N1, Nm2, _
  1287.        " To Return to Personal Calendar, Type EXIT Then Press Return ")
  1288.     RETURN
  1289. ExitPoint3:
  1290.         Subnum = SubnumSave
  1291.     END SUB
  1292.     '=========================================================================
  1293.     SUB EndItAll STATIC
  1294.     '=========================================================================
  1295.     DEFINT A-Z
  1296.         SubnumSave = Subnum
  1297.         Subnum = 105
  1298.     '  (From Ctl-Esc or Ctl-Break or Esc from main menu)
  1299.     CALL SetCurrentDirectory(N1)             ' Return to calendar's directory
  1300.     IF MemoryResident THEN
  1301.         IF PoppedUpOverProgram THEN
  1302.             ErrorLine1$ = _
  1303.       "Can't Quit Unless Last In Memory and Over DOS; Pop Down (F10) Instead"
  1304.             ERROR 253                      ' Return to Main Menu
  1305.         END IF
  1306.     END IF
  1307.     CALL CloseFiles
  1308.     CALL ClearOverdueTable
  1309.     CALL ClearScreenNormal(N0)
  1310.     CALL BoxDraw(N2%, N1%, N24%, N1%, N80%)
  1311.     CALL BigChars(N3%, N6%, "Thank you for using")
  1312.     CALL Kolors(N7)
  1313.     CALL BigChars(N8%, N6%, "Personal Calendar--")
  1314.     CALL Kolors(N6%)
  1315.     CALL Credits(N18)
  1316.     DO                                 ' Clear keystroke buffer
  1317.     LOOP WHILE LEN(INKEY$)
  1318.     IF ColorCRT THEN CALL Kolors(N3) ELSE CALL Kolors(N7)
  1319.     IF MemoryResident THEN
  1320.         ' Do a TSR Unload 
  1321.         '  (remove program from memory).
  1322.         CALL BigChars(N13%, N6%, "Removed from memory")
  1323.         IF SrDiskSwapped THEN
  1324.             CALL ShowIt(N6, N17, Nm2, "(And Deleted Disk Swap Files)")
  1325.         END IF
  1326.         CALL Kolors(N99)
  1327.         CALL Snooze(1.7!)                   ' Pause before screen restore
  1328.         CALL SetVideoMode(N1)            ' and mode
  1329.         CALL SetVideoPage(N1)            ' Set User Page
  1330.         GOSUB RestoreKeys                   ' Restore Keys and Cursor
  1331.             Subnum = SubnumSave
  1332.         '====================================================================
  1333.         CALL SrReleaseMem(RelEcode%)  ' Resident Program Exit
  1334.         '====================================================================
  1335.         '  ONLY COMES HERE IF MEMORY RELEASE IS NOT SUCCESSFUL
  1336.         '--------------------------------------------------------------------
  1337.         Ecode = RelEcode
  1338.         IF Ecode = N7 THEN
  1339.             FatalError = No
  1340.             IF ApptFile THEN
  1341.                 DirectReturn = Yes
  1342.                 Menu1 = MainMenuLastEntry
  1343.                 CALL OpenAppts ' Reopen Appts
  1344.             END IF
  1345.           ELSEIF Ecode THEN
  1346.             FatalError = Yes
  1347.         END IF
  1348.         ERROR 254                          ' Return to main menu
  1349.       ELSE
  1350.         ' Non Memory-Resident Exit comes here.
  1351.         IF UserMode <> CalMode OR _            ' If not going back to
  1352.            DOSCursorPage <> ScreenPage THEN
  1353.             HardSnooze = Yes                ' same page or mode, pause
  1354.             CALL Snooze(1.7!)                ' so user can read farewell
  1355.           ELSE
  1356.             CALL Kolors(N99)
  1357.         END IF
  1358.         CALL SetVideoMode(N1)            ' and mode
  1359.         CALL SetVideoPage(N1)            ' Set User Page
  1360.         GOSUB RestoreKeys                    ' Restore Keys and Cursor
  1361.         '====================================================================
  1362.         SYSTEM                        ' Non-Resident Program Exit
  1363.         '====================================================================
  1364.     END IF
  1365.     '  Program Never Terminates Here
  1366. RestoreKeys:
  1367.     CALL RestoreDOSKeyState
  1368.     LOCATE 24, N1, N1, InsertCursorStart, CursorStop' Normal DOS Cursor
  1369.     RETURN
  1370. RestoreState:
  1371.     RETURN
  1372.     END SUB
  1373.     '=========================================================================
  1374.     SUB ErrorHandler  STATIC
  1375.     '=========================================================================
  1376.     DEFINT A-Z
  1377.     Suberror = Subnum            ' Save SUB that was in error
  1378.         Subnum = 23
  1379.     DO                            ' Hard clear of keystroke buffer
  1380.     LOOP WHILE LEN(INKEY$)
  1381.     ErrorNumber = ERR                ' Save error number
  1382.     ToShow = ErrorNumber
  1383.     MhEcode = Ecode
  1384.     LastErrorMessage = 269            ' Set last stored error message limit
  1385.     IF ErrorNumber = 253 THEN        ' Remove attempts
  1386.         FatalError = No            ' Or pop attempts when
  1387.         ClockScreen = No            ' locked into memory
  1388.         InHelp = No
  1389.         OnEditPage = No
  1390.         CALL ClearScreenNormal(N1)    ' Write Error Message
  1391.         CALL DirectReturnCheck            ' and return to main menu
  1392.         CALL PrepareforMessage
  1393.         CALL ShowIt(N0, N0, N0, ErrorLine1$)
  1394.         ErrorMessageToWrite = No
  1395.         GOTO ExitPoint4
  1396.     END IF
  1397.     IF ErrorNumber = N0 THEN GOTO ExitPoint4    ' If no error, get out
  1398.     '           Error Handling
  1399.     ScreenRow = ErrMsgPlacement
  1400.     IF ErrorNumber = 254 OR ErrorNumber = 255 THEN
  1401.         ToShow = MhEcode            ' Stay-Res or Mach 2
  1402.         FatalError = No
  1403.     END IF
  1404.     IF FatalError THEN                ' Event safety
  1405.         CALL CloseFiles
  1406.         EventTableStable = No
  1407.     END IF
  1408.     IF FileExist("calerror.dat") THEN                ' Get SUB Name
  1409.         OPEN "R", FilenumError, "calerror.dat", N80    
  1410.         FIELD FilenumError, N80 AS HelpErrorBuffer$    
  1411.         ' Starting at rec 270 in CALERROR.DAT are module numbers &
  1412.         '  procedure names for trace (270 is main program)
  1413.         GET #FilenumError, LastErrorMessage + 1 + Suberror            
  1414.         JJ = LastErrorMessage           ' Get Number of Last Record
  1415.       ELSE
  1416.         JJ = N0
  1417.     END IF
  1418.     IF JJ THEN                    ' Construct Message
  1419.         ErrorLine1Base$ = " Error" + STR$(ToShow) + _
  1420.             " Detected In Procedure '" + RTRIM$(MID$(HelpErrorBuffer$, _
  1421.             N2, LEN(HelpErrorBuffer$) - N1)) + "' of module CAL" + _
  1422.             LEFT$(HelpErrorBuffer$, N1) + ":"
  1423.       ELSE
  1424.         ErrorLine1Base$ = " Error" + STR$(ToShow) + _
  1425.             " Detected, But Error Message File CALERROR.DAT Does Not Exist"
  1426.     END IF
  1427.     IF ErrorNumber > 253 THEN
  1428.         ' MicroHelp Errors
  1429.         SELECT CASE ErrorNumber
  1430.             CASE 255                 'Mach 2 Errors
  1431.                 SELECT CASE MhEcode      ' Computer Error Message Loc
  1432.                     CASE 1 TO 254       ' In File
  1433.                         ErrorNumber = MhEcode + 250' Crits Start at 251
  1434.                     CASE 255
  1435.                         ErrorNumber = 250        ' Except 255 which at 250
  1436.                     CASE IS > 256
  1437.                         ErrorNumber = MhEcode - 156' Non Crits start 101
  1438.                     CASE ELSE
  1439.                         ErrorNumber = 500        ' Beyond End Of File
  1440.                 END SELECT
  1441.             CASE 254                 'Stay-Res Plus Errors
  1442.                 IF StartupScreenHold THEN EarlyPopDownFailed = Yes
  1443.                 ErrorNumber = MhEcode + 200        ' Stay-Res is 200 to 215
  1444.         END SELECT
  1445.         ErrorLine1$ = "MicroHelp" + ErrorLine1Base$
  1446.       ELSE
  1447.         ' Microsoft Errors
  1448.         ErrorLine1$ = "BASIC" + ErrorLine1Base$
  1449.     END IF
  1450.     IF ErrorNumber <= JJ OR JJ = N0 THEN
  1451.         GET FilenumError, ErrorNumber
  1452.         IF HelpErrorBuffer$ = SPACE$(N80) OR JJ = N0 THEN
  1453.             ErrorLine2$ = "(No Error Text Available)"
  1454.           ELSE
  1455.             ErrorLine2$ = HelpErrorBuffer$
  1456.         END IF
  1457.     END IF
  1458.     ErrorMessageToWrite = Yes
  1459.     IF FatalError THEN
  1460.         CALL CloseFiles
  1461.       ELSE
  1462.         CLOSE FilenumError
  1463.     END IF
  1464.     IF PrimitiveState THEN            ' here, we're preparing for a 
  1465.         PRINT
  1466.         PRINT ErrorLine1$            ' about 50-60 bytes to the stack
  1467.         PRINT ErrorLine2$
  1468.         PRINT
  1469.         PRINT "Program initialization is incomplete.  Cannot proceed."
  1470.         SYSTEM
  1471.     END IF
  1472.     ErrorNumber = N0
  1473. ExitPoint4:
  1474.     CALL SetCurrentDirectory(N1)        ' Set Program Directory
  1475.     ' Check video lines and reset
  1476.     CALL SetVideoMode(N0)            ' set calendar mode
  1477.     CALL SetVideoPage(N0)            '  and page
  1478.     AllowInsertMode = No            ' Turn off insert mode
  1479.     AutoStarted = No                ' Turn off autostart
  1480.     SrAutoPopDown = No
  1481.     SrAutoPopDownReady = No
  1482.     SrAutoPopDownHappened = No
  1483.     ClockScreen = No                ' Set in menu, not anything else
  1484.     OnEditPage = No
  1485.     InHelp = No
  1486.     OnOverduePage = No
  1487.     EditingEvents = No                ' Turn off event edit
  1488.     EditingNotes = No
  1489.     InPopDown = No                    ' Turn off popping down
  1490.     LoopCounterShow = Yes            ' Set debug counter on
  1491.     MenuChoice = N1                ' Set main menu to top
  1492.     MenuSingleLine = No                ' Reset menu driver
  1493.     WhichColor = N0
  1494.     CursorState = N0
  1495.     IF FatalError THEN DirectReturn = No
  1496.     LOCATE CursorRow, CursorColumn, CursorState    ' Turn off cursor
  1497.         Subnum = Suberror
  1498.     END SUB
  1499.     '=========================================================================
  1500.     SUB EscapeLine STATIC
  1501.     '=========================================================================
  1502.     DEFINT A-Z
  1503.         SubnumSave = Subnum
  1504.         Subnum = 24
  1505.     CALL EscapeLineDelete
  1506.     CALL ShowIt(N7, N25, N43, " Esc ")
  1507.     CALL ShowIt(N6, N0, Nm1, "Return")
  1508.         Subnum = SubnumSave
  1509.     END SUB
  1510.     '=========================================================================
  1511.     SUB EscapeLineDelete STATIC
  1512.     '=========================================================================
  1513.     DEFINT A-Z
  1514.         SubnumSave = Subnum
  1515.         Subnum = 25
  1516.     CALL ShowErase(N6, N25, N43, N19, Blank0$)
  1517.         Subnum = SubnumSave
  1518.     END SUB
  1519.     '=========================================================================
  1520.     SUB EventErrorMessage STATIC
  1521.     '=========================================================================
  1522.     DEFINT A-Z
  1523.         SubnumSave = Subnum
  1524.         Subnum = 26
  1525.     IF ReturnMessage$ <> Blank0$ THEN                 ' Limit Message Length
  1526.         WindowLength = LEN(EditInstructions(N1, N1))
  1527.         IF LEN(ReturnMessage$) > WindowLength THEN
  1528.             ReturnMessage$ = LEFT$(ReturnMessage$, WindowLength)
  1529.         END IF
  1530.         StartColumn = (WindowLength - LEN(ReturnMessage$)) \ N2
  1531.         ' Compute and Locate Position
  1532.         CALL ShowIt(N16, N22, StartColumn, ReturnMessage$)
  1533.         ReturnMessage$ = Blank0$           ' Blank Message After Display
  1534.     END IF                                  '  to Prevent Repeated Display
  1535.         Subnum = SubnumSave
  1536.     END SUB
  1537.     '=========================================================================
  1538.     FUNCTION FileExist(ExistFilename$) STATIC
  1539.     '=========================================================================
  1540.     DEFINT A-Z
  1541.         SubnumSave = Subnum
  1542.         Subnum = 120
  1543.     CALL MhFileExist((ASCIIZ$(ExistFilename$)), ExistEcode%)
  1544.     IF ExistEcode THEN
  1545.         FileExist = No
  1546.       ELSE
  1547.         FileExist = Yes
  1548.     END IF
  1549.         Subnum = SubnumSave
  1550.     END FUNCTION
  1551.     '=========================================================================
  1552.     SUB FileFormat STATIC
  1553.     '=========================================================================
  1554.     DEFINT A-Z
  1555.         SubnumSave = Subnum
  1556.         Subnum = 27
  1557.     '
  1558.     '   EXIT FROM PROGRAM IS STOPPED FROM FILE CHANGE TO OPTIONS RESET!
  1559.     '
  1560.     '   Change File Based On Size -- Called From Options Menu Now
  1561.     '    NumberofEvents and Notes Is Already Updated to New Value
  1562.     '    OldNumberEvents and Notes Has Previous Values
  1563.     ExitKeys = No
  1564.     SELECT CASE WhichExpansion$
  1565.         CASE "e"
  1566.             OldNumber = OldNumberEvents        '  Expand Events
  1567.             NewNumber = NumberofEvents
  1568.             PrintLabel$ = "Events"
  1569.         CASE False$
  1570.             OldNumber = OldNumberNotes    '  Expand Notes         
  1571.             NewNumber = NumberofNotes
  1572.             PrintLabel$ = "Notes"
  1573.         CASE ELSE
  1574.             ExitKeys = Yes
  1575.             GOTO ExitPoint5
  1576.     END SELECT
  1577.     '  Display Warning Notice
  1578.     CALL MinorBeeper
  1579.     CALL Kolors(N6)
  1580.     CALL ClearLast4                    ' Changing ... on line 23
  1581.                                 ' Compressing ... on line 24
  1582.                                 ' Moving ... on line 25
  1583.     CALL ShowMult(N14, N23, N1, N80, N3)
  1584.     Lin$ = "Please Wait--Changing Appointment File Size From" + _
  1585.         STR$(OldNumber) + " To" + STR$(NewNumber)
  1586.     IF WhichExpansion$ = "e" THEN
  1587.         Lin$ = Lin$ + " Events"
  1588.       ELSE
  1589.         Lin$ = Lin$ + " Notes"
  1590.     END IF
  1591.     CALL ShowIt(N0, N23, N8, Lin$)
  1592.     Excess = ABS(NewNumber - OldNumber)
  1593.     IF (NewNumber - OldNumber) < N0 THEN
  1594.         '  Shrink File
  1595.         CompressFile = N1    '  Compress Excess
  1596.         ' Move Excess to History unless Events and Arrays Null From Prior Move
  1597.         IF WhichExpansion$ = False$ OR EventTableStable THEN
  1598.             IF WhichExpansion$ = "e" THEN
  1599.                 '  Shrink Events
  1600.                 '    Copy Excess Events to History
  1601.                 EventtoHistory = Yes
  1602.               ELSE
  1603.                 EventtoHistory = No
  1604.             END IF
  1605.             Lin$ = "Moving Last" + STR$(Excess) + Blank1$ + PrintLabel$ + _
  1606.                 " to History"
  1607.             FOR I = Excess TO N1 STEP Nm1
  1608.                 CALL KeyStuff(KeyStatus)
  1609.                 IF WhichExpansion$ = "e" THEN
  1610.                     WhichEvent = OldNumberEvents - I + N1
  1611.                     CALL ApptToMenu(N1)
  1612.                     HistoryBuffer$ = CurrentEventLine$
  1613.                   ELSE
  1614.                     Pointer = StartingNote + OldNumberNotes - I
  1615.                     CALL GetApptRecord(Pointer)
  1616.                     HistoryBuffer$ = ApptBuffer$
  1617.                 END IF
  1618.                 CALL WritetoHistory
  1619.                 Lin1$ = Lin$ + STR$(I - N1) + SPACE$(4)
  1620.                 CALL ShowIt(N14, N24, N8, Lin1$)
  1621.             NEXT
  1622.         END IF
  1623.         '    Move Notes and History Back In File
  1624.         Lin$ = "       Moving "
  1625.         IF WhichExpansion$ = "e" THEN Lin$ = Lin$ + "Notes/"
  1626.         Lin$ = Lin$ + "History Backward In File"
  1627.         CALL ShowErase(N0, N24, N1, N80, Lin$)
  1628.         EOFRecord = LOF(FilenumAppt) \ N80
  1629.         IF WhichExpansion$ = "e" THEN
  1630.             MoveStart = StartingNote
  1631.           ELSE
  1632.             MoveStart = StartingHistory
  1633.         END IF
  1634.         CALL MoveApptRecords(N1, MoveStart, EOFRecord, N1, _
  1635.             N0, -Excess, N1, N0, N0)
  1636.       ELSE
  1637.         '  Expand File
  1638.         CompressFile = N0    '  Don't Compress
  1639.         EOFRecord = LOF(FilenumAppt) \ N80
  1640.         CALL ShowErase(N0, N24, N1, N80, Blank0$)
  1641.         IF WhichExpansion$ = "e" OR StartingHistory < EOFRecord THEN
  1642.             Lin$ = "Moving "
  1643.             IF WhichExpansion$ = "e" THEN
  1644.                 Lin$ = Lin$ + "Notes/"
  1645.                 MoveEnd = StartingNote
  1646.               ELSE
  1647.                 MoveEnd = StartingHistory
  1648.             END IF
  1649.             Lin$ = Lin$ + "History Forward" + STR$(Excess) + " In File"
  1650.             CALL ShowIt(N0, N24, N8, Lin$)
  1651.             ' Move the Records
  1652.             CALL MoveApptRecords(N1, EOFRecord, MoveEnd, Nm1, N0, _
  1653.                 Excess, N1, N0, N0)
  1654.             ' Blank the New Area
  1655.             '  This is done separately, because there could be far fewer
  1656.             '   records to move then to clear in the new area
  1657.             CALL ShowErase(N0, N24, N1, N80, _
  1658.                 "       Clearing Area For New Records")
  1659.             CALL MoveApptRecords(N1, MoveEnd, MoveEnd + _
  1660.                 Excess - N1, N1, N0, N0, N0, N1, N0)
  1661.             CALL ShowErase(N0, N24, N1, N80, Blank0$)
  1662.         END IF
  1663.     END IF
  1664.     IF CompressFile = N1 THEN CALL CompressApptFile(Excess)
  1665.     IF WhichExpansion$ = "e" THEN
  1666.         EventSizeCode$ = MID$(ValidSizes$, (NewNumber \ 20), N1)
  1667.       ELSE
  1668.         NoteSizeCode$ = MID$(ValidSizes$, (NewNumber \ 20), N1)
  1669.     END IF
  1670.     CALL SetArrays
  1671.     CALL SetOptions
  1672.     ExitKeys = Yes
  1673.     '           Set Options To Expanded
  1674. ExitPoint5:
  1675.         Subnum = SubnumSave
  1676.     END SUB
  1677.     '=========================================================================
  1678.     SUB FileList STATIC
  1679.     '=========================================================================
  1680.     '  Display a List of Saved Appointment Files
  1681.     DEFINT A-Z
  1682.         SubnumSave = Subnum
  1683.         Subnum = 106
  1684.     CALL ClearScreenNormal(N1)
  1685.     ScreenTitles$(N1) = "Saved Appointment Files"
  1686.     CALL Titles(Nm1)
  1687.     CALL Kolors(N6)
  1688.     CursorRow = N6
  1689.     CursorColumn = N1
  1690.     CALL KeyStuff(KeyCursorOff)             ' Position Cursor for FILES
  1691.     ErrorSwitch = No
  1692.     CALL FileListGet                ' for error handling in CAL1
  1693.     IF ErrorSwitch THEN
  1694.         ErrorSwitch = No
  1695.         CALL ShowIt(N7, N15, Nm2, " There Are No Saved Appointment Files ")
  1696.         Menu1 = MainMenuCreate
  1697.     END IF
  1698.     '  Clear DOS prompt and give one of our own
  1699.     CALL ClearLast3
  1700.     CALL ScreenBottoms
  1701.     CALL ReturnLineDelete
  1702.     CALL KeyStuff(KeyWait)             ' Wait for a keystroke
  1703.     CALL ClearScreenNormal(N1)
  1704.     CALL DirectReturnCheck
  1705.         Subnum = SubnumSave
  1706.     END SUB
  1707.     '=========================================================================
  1708.     SUB GenerateGreeting (GrLines) STATIC
  1709.     '=========================================================================
  1710.     '    Generate Main Menu Greeting Lines
  1711.     DEFINT A-Z
  1712.         SubnumSave = Subnum
  1713.         Subnum = 28
  1714.     ScreenTitles$(N1) = "Personal Calendar (PC) for DOS"
  1715.     ScreenTitles$(N2) = "Version " + ProgramVersion$
  1716.     ScreenTitles$(N3) = "Main Menu"     ' Shown Optionally
  1717.     CALL Titles(GrLines)
  1718.         Subnum = SubnumSave
  1719.     END SUB
  1720.     '=========================================================================
  1721.     SUB GenGreetingScreen1  STATIC
  1722.     '=========================================================================
  1723.     '    Generate Startup Screen
  1724.     DEFINT A-Z
  1725.         SubnumSave = Subnum
  1726.         Subnum = 119
  1727.     CALL Kolors(N6)
  1728.     CALL BoxDraw(N2, N1, N25, N1, N80)
  1729.     IF RIGHT$(ProgramVersion$, N1) = "ß" THEN        'Beta Warning
  1730.         CALL MinorBeeper
  1731.         CALL ShowIt(N9, N2, Nm2, _
  1732.        " Beta Release -- You may not distribute without my permission !! ")
  1733.     END IF
  1734.     CALL Kolors(N7)
  1735.     CALL BigChars(N3%, N10%, "Personal Calendar")
  1736.     CALL Kolors(N6)
  1737.     CALL BigChars(N8%, N22%, "PC for DOS")
  1738.     IF ColorCRT THEN CALL Kolors(N3) ELSE CALL Kolors(N7)
  1739.     CALL BigChars(N13%, N18%, "Version " + ProgramVersion$)
  1740.     CALL Credits(N18)
  1741.     CALL ShowIt(N7, N24, Nm2, "Press a Key to Continue ...")
  1742.         Subnum = SubnumSave
  1743.     END SUB
  1744.     '=========================================================================
  1745.     SUB GetFilenameLength STATIC
  1746.     '=========================================================================
  1747.     '  Get the Length of the Appointment File Name
  1748.     DEFINT A-Z
  1749.         SubnumSave = Subnum
  1750.         Subnum = 29
  1751.     FilenameLength = InString(ApptFilename$, Blank1$) - N1
  1752.     IF FilenameLength <= N0 THEN FilenameLength = 8
  1753.         Subnum = SubnumSave
  1754.     END SUB
  1755.     '=========================================================================
  1756.     SUB GetOptions STATIC
  1757.     '=========================================================================
  1758.     '   Get Option Variables From Option Record
  1759.     DEFINT A-Z
  1760.         SubnumSave = Subnum
  1761.         Subnum = 30
  1762.     CALL GetApptRecord(N1)
  1763.     ApptMasterRec$ = ApptBuffer$
  1764.     '  Pos 1-8 Password
  1765.     ApptPassword$ = MID$(ApptMasterRec$, N1, 8)
  1766.     '  Pos 9 Footer Size
  1767.     FooterSize = VAL(MID$(ApptMasterRec$, 9, N1))
  1768.     IF FooterSize < N3 OR FooterSize > 9 THEN FooterSize = 5
  1769.     '  Pos 10 Alarm Initial Condition
  1770.     InitialSound$ = MID$(ApptMasterRec$, 10, N1)
  1771.     IF VAL(InitialSound$) THEN
  1772.         SoundLevel = VAL(InitialSound$)
  1773.       ELSE
  1774.         '  Old Sound Levels
  1775.         IF InitialSound$ = True$ THEN SoundLevel = 4
  1776.         IF InitialSound$ = False$ THEN SoundLevel = N1
  1777.     END IF
  1778.     '  Pos 11 Size Of Note Area
  1779.     NoteSize = VAL(MID$(ApptMasterRec$, 11, N1))
  1780.     IF NoteSize < N0 OR NoteSize > (FooterSize - N1) THEN NoteSize = N2
  1781.     '  Pos 13 Print,Copy History
  1782.     IncludeHistory$ = MID$(ApptMasterRec$, 13, N1)
  1783.     IF IncludeHistory$ = True$ THEN InclHistory = Yes ELSE InclHistory = No
  1784.     '  Pos 14 Print,Copy Notes
  1785.     IncludeNotes$ = MID$(ApptMasterRec$, 14, N1)
  1786.     IF IncludeNotes$ = True$ THEN InclNotes = Yes ELSE InclNotes = No
  1787.     '  Pos 15 Allow Weekends On Daily
  1788.     WeekendScheduling$ = MID$(ApptMasterRec$, 15, N1)
  1789.     '  Pos 16 Number of Events
  1790.     EventSizeCode$ = MID$(ApptMasterRec$, 16, N1)
  1791.     IF EventSizeCode$ = Blank1$ THEN EventSizeCode$ = LEFT$(ValidSizes$, N1)
  1792.     '  Pos 17-18  Event Look-Ahead (Defaults to 5 if blank)
  1793.     Pending = VAL(MID$(ApptMasterRec$, 17, N2))
  1794.     IF MID$(ApptMasterRec$, 17, N2) = SPACE$(N2) THEN Pending = 5
  1795.     '  Pos 19  Selected IBM "I" or Epson "E" Printer or "P" HPIIP or "N"one
  1796.     SelectedPrinter$ = MID$(ApptMasterRec$, 19, N1)
  1797.     IF SelectedPrinter$ = Blank1$ THEN SelectedPrinter$ = "-"
  1798.     '  Pos 20  Week Break on ASCII File or Print
  1799.     WeekBreak$ = MID$(ApptMasterRec$, 20, N1)
  1800.     IF WeekBreak$ = Blank1$ THEN WeekBreak$ = True$
  1801.     '  Pos 21  60 Notes "e"
  1802.     NoteSizeCode$ = MID$(ApptMasterRec$, 21, N1)
  1803.     IF NoteSizeCode$ = Blank1$ THEN
  1804.         NoteSizeCode$ = MID$(ValidSizes$, (NumberofNotes \ 20), N1)
  1805.     END IF
  1806.     '  Pos 22-23  Printer page line limit
  1807.     PrinterLineLimit = VAL(MID$(ApptMasterRec$, 22, N2))
  1808.     '  Pos 24  Printer pause indicator
  1809.     PrinterPause$ = MID$(ApptMasterRec$, 24, N1)
  1810.     IF PrinterPause$ = Blank1$ THEN PrinterPause$ = False$
  1811.     '-------------------------------------------------------------------------
  1812.     '  Set Printer Array
  1813.     FOR I = N1 TO 50
  1814.         CALL KeyStuff(KeyStatus)
  1815.         SELECT CASE SelectedPrinter$
  1816.             CASE "I"
  1817.                 PrinterCodes(I) = IBMCodes(I)
  1818.             CASE "E"
  1819.                 PrinterCodes(I) = EpsonCodes(I)
  1820.             CASE "P"
  1821.                 PrinterCodes(I) = HPIIPCodes(I)
  1822.             CASE "4"
  1823.                 PrinterCodes(I) = I4019Codes(I)
  1824.             CASE ELSE
  1825.                 EXIT FOR
  1826.         END SELECT
  1827.     NEXT
  1828.     '-------------------------------------------------------------------------
  1829.         Subnum = SubnumSave
  1830.     END SUB
  1831.     '=========================================================================
  1832.     SUB Help STATIC
  1833.     '=========================================================================
  1834.     '   HELP!!!
  1835.     DEFINT A-Z
  1836.         SubnumSave = Subnum
  1837.         Subnum = 108
  1838.     ErrorSwitch = No
  1839.     ScreenSize = 20
  1840.     InHelp = Yes
  1841.     IF NOT FileExist("calhelp.dat") THEN
  1842.         InHelp = No
  1843.         CALL PrepareforError
  1844.         CALL ShowIt(N0, N0, N0, _
  1845.     "The Help Information File CALHELP.DAT Was Not Found Or Is Defective")
  1846.         GOTO HelpExit
  1847.     END IF
  1848.     OPEN "R", FilenumHelp, "calhelp.dat", N80
  1849.     FIELD FilenumHelp, N80 AS HelpErrorBuffer$
  1850.     LastRecord = LOF(FilenumHelp) \ N80           'Last Record Number
  1851.     LastPage = N1 + ((LastRecord - N1) \ ScreenSize)'Last Page
  1852.     CurrentRecord = N1
  1853.     CurrentPage = N1
  1854.     '  Start New Page
  1855. NewHelpPage:
  1856.     CALL ClearScreenNormal(N0)
  1857.     CALL ScreenBottoms
  1858.     CALL ReturnLineDelete
  1859.     CALL KeyStuff(KeyStatusAbs)
  1860.     CurrentRecord = N1 + (CurrentPage - N1) * ScreenSize
  1861.     CALL ShowIt(N6, N21, N1, (Strng$(N80, 196))) ' horizontal solid line
  1862.     CALL ShowIt(N7, N23, N1, "*,Print")
  1863.     CALL ShowIt(N6, N0, Nm1, " Print Help Text")
  1864.     IF CurrentRecord > ScreenSize THEN
  1865.         CALL ShowIt(N7, N24, N1, "PgUp")
  1866.         CALL ShowIt(N6, N0, Nm1, " Previous Page")
  1867.         CALL ShowIt(N7, N0, N27, "Home")
  1868.         CALL ShowIt(N6, N0, Nm1, " 1st Page")
  1869.     END IF
  1870.     IF CurrentPage < LastPage THEN
  1871.         CALL ShowIt(N7, N25, N1, "PgDn")
  1872.         CALL ShowIt(N6, N0, Nm1, " Next Page")
  1873.         CALL ShowIt(N7, N0, N27, "End")
  1874.         CALL ShowIt(N6, N0, Nm1, " Last Page")
  1875.     END IF
  1876.     CALL ShowIt(N6, N22, N63, "Page")
  1877.     CALL ShowIt(N0, N0, Nm1, _
  1878.         (STR$(CurrentPage) + " of" + STR$(LastPage)))
  1879.     CALL ShowIt(N7, Nm2, N63, "Ins")
  1880.     CALL ShowIt(N6, N0, Nm1, " Specific Page")
  1881.     '  Get Next Record
  1882. GetHelpRecord:
  1883.     GET FilenumHelp, CurrentRecord
  1884.     '  Set Screen Position
  1885.     ScreenPosition = (CurrentRecord - N1) MOD ScreenSize
  1886.     CALL ShowIt(N0, (ScreenPosition + N1), N1, HelpErrorBuffer$)
  1887.     '  End File  or  End Page
  1888.     IF CurrentRecord < LastRecord AND _
  1889.       (CurrentRecord MOD ScreenSize) <> N0     THEN
  1890.         CurrentRecord = CurrentRecord + N1
  1891.         GOTO GetHelpRecord
  1892.     END IF
  1893. NextHelpKey:
  1894.     CALL KeyStuff(KeyWait)             ' Wait for a keystroke
  1895.     SELECT CASE LEN(Keystroke$)
  1896.         CASE 1                        '  Length 1 Keys (Esc,Prnt)
  1897.             SELECT CASE InString(CHR$(Esc) + CHR$(Prnt), _
  1898.                              RIGHT$(Keystroke$, N1))
  1899.                 CASE 1                   ' Esc Key
  1900.                     CLOSE FilenumHelp
  1901.                     InHelp = No
  1902.                     CALL ClearScreenNormal(N1)
  1903.                     CALL ScreenBottoms
  1904.                     CALL DirectReturnCheck
  1905.                     GOTO HelpExit
  1906.                 CASE 2                   ' Prnt Key
  1907.                     '  Print Help Text
  1908.                     LprintTerminate = No
  1909.                     CALL InitPrinter    'Initialize Printer
  1910.                     FOR JJ = N1 TO LastRecord
  1911.                         IF LprintTerminate THEN EXIT FOR
  1912.                         '  On Page Break
  1913.                         IF ((JJ - N1) MOD ScreenSize) = N0 THEN
  1914.                             PageNumber = N1 + ((JJ - N1) \ ScreenSize)
  1915.                             CALL ClearScreenNormal(N0)
  1916.                             CALL ScreenBottoms
  1917.                             CALL ShowIt(N7, N24, N1, _
  1918.                                 "Printing Help File Text -- Please Wait")
  1919.                             CALL ShowIt(N0, Nm1, N1, ("Page" + _
  1920.                                 STR$(PageNumber) + " of" + _
  1921.                                 STR$(LastPage)))
  1922.                             IF PageNumber MOD N2 = N1 THEN 
  1923.                                 IF JJ <> N1 THEN
  1924.                                     CALL PageEject
  1925.                                 END IF
  1926.                               ELSE
  1927.                                 CALL LprintString(Blank1$, N0)
  1928.                             END IF
  1929.                             CALL LprintString(Blank1$, N0)
  1930.                             '  hyphens
  1931.                             CALL LprintString(Strng$(N80, N45), N0)
  1932.                             PrintString$ = "Personal Calendar (PC) " + _
  1933.                               "for DOS, version " + ProgramVersion$ + _
  1934.                               ", Help File Text, Page" + _
  1935.                                 STR$(PageNumber)
  1936.                             CALL LprintString(PrintString$, N0)
  1937.                             CALL LprintString(Strng$(N80, N45), N0)
  1938.                             CALL LprintString(Blank1$, N0)
  1939.                         END IF
  1940.                         GET FilenumHelp, JJ
  1941.                         Buffer80$ = HelpErrorBuffer$
  1942.                         CALL KeyStuff(KeySingle)
  1943.                         IF Keystroke$ = CHR$(Esc) THEN EXIT FOR
  1944.                             CALL LprintString(Buffer80$, N0)
  1945.                             ScreenPosition = (JJ - N1) MOD ScreenSize
  1946.                             CALL ShowIt(N6, (ScreenPosition + N1), N1, _
  1947.                                 Buffer80$)
  1948.                     NEXT
  1949.                     IF NOT LprintTerminate THEN
  1950.                         CALL PageEject
  1951.                         LprintJobOver = Yes
  1952.                         CALL LprintString(Blank0$, N0)
  1953.                       ELSE
  1954.                         LprintTerminate = No
  1955.                     END IF
  1956.                     GOTO NewHelpPage
  1957.                 CASE ELSE                ' Other Length 1 Key
  1958.                     GOTO BadHelpKey
  1959.             END SELECT
  1960.         CASE 2                        '  Length 2 Keys
  1961.         '  Length 2 keys -- Next,Prev,First,Last,SpecificPage
  1962.         SELECT CASE InString(CHR$(PgUp) + CHR$(PgDn) + CHR$(HomeKey) + _
  1963.                        CHR$(EndKey) + CHR$(Ins), RIGHT$(Keystroke$, N1))
  1964.             CASE 1, 3                '  PgUp or Home
  1965.                 IF CurrentPage <= N1 THEN GOTO BadHelpKey
  1966.                 '  Pg Up or Home
  1967.                 IF RIGHT$(Keystroke$, N1) = CHR$(PgUp) THEN
  1968.                     CurrentPage = CurrentPage - N1      'PgUp
  1969.                   ELSE
  1970.                     CurrentPage = N1                    'Home
  1971.                 END IF
  1972.                 GOTO NewHelpPage
  1973.             CASE 2, 4                '  PgDn or End
  1974.                 IF CurrentPage >= LastPage THEN GOTO BadHelpKey
  1975.                 IF RIGHT$(Keystroke$, N1) = CHR$(PgDn) THEN
  1976.                     CurrentPage = CurrentPage + N1      'PgDn
  1977.                   ELSE
  1978.                     CurrentPage = LastPage             'End
  1979.                 END IF
  1980.                 GOTO NewHelpPage
  1981.             CASE 5                   '  Ins (Specific Page)
  1982.                 CALL ShowErase(N6, N22, N1, N26, Blank0$)'clear instructions
  1983.                 CALL ShowMult(N6, N23, N1, N42, N3)     '  & for Ins Prompt
  1984.                 InputResponse$ = MID$(STR$(CurrentPage), N2, N2)
  1985.                 CALL ControlledInput(N22, N2, N22, N6, N3, _
  1986.                     "Enter Page Number", InputResponse$, _
  1987.                     N1, N0, N1, N1)
  1988.                 CurrentPage = VAL(InputResponse$)
  1989.                 IF CurrentPage < N1 THEN CurrentPage = N1
  1990.                 IF CurrentPage > LastPage THEN CurrentPage = LastPage
  1991.                 GOTO NewHelpPage
  1992.             CASE ELSE
  1993. BadHelpKey:
  1994.                 CALL MinorBeeper
  1995.                 GOTO NextHelpKey
  1996.         END SELECT
  1997.     END SELECT
  1998. HelpExit:
  1999.         Subnum = SubnumSave
  2000.     END SUB
  2001.     '=========================================================================
  2002.     SUB IncrementDate (DateToIncrement$) STATIC
  2003.     '=========================================================================
  2004.     '   Given A Date, Find The Next One
  2005.     '           Increment Date
  2006.     DEFINT A-Z
  2007.         SubnumSave = Subnum
  2008.         Subnum = 31
  2009.     IncrementYear = VAL(MID$(DateToIncrement$, N1, 4))
  2010.     IncrementMonth = VAL(MID$(DateToIncrement$, 5, N2))
  2011.     IncrementDay = VAL(MID$(DateToIncrement$, N7, N2))
  2012.     IF IncrementMonth <> N2 OR IncrementDay <> 28 THEN ' Not Leap Year
  2013.         IF IncrementDay < MonthLength(IncrementMonth) THEN
  2014.             IncrementDay = IncrementDay + N1
  2015.             GOTO DoLeap
  2016.         END IF
  2017.         IncrementDay = N1
  2018.         ' Last Day
  2019.         IF IncrementMonth = 12 THEN        '  Last Month
  2020.             IncrementMonth = N1
  2021.             IncrementYear = IncrementYear + N1
  2022.             GOTO DoLeap
  2023.         END IF
  2024.         IncrementMonth = IncrementMonth + N1
  2025.         GOTO DoLeap
  2026.     END IF
  2027.     ' Leap Year Test
  2028.     IF Leap(IncrementYear) THEN
  2029.         IncrementMonth = N2
  2030.         IncrementDay = 29
  2031.       ELSE
  2032.         IncrementMonth = N3
  2033.         IncrementDay = N1
  2034.     END IF
  2035.     '           Leap Year
  2036. DoLeap:
  2037.     CALL YearAdjust(IncrementYear, AdjustedYear$)
  2038.     DateToIncrement$ = ZeroFill$(AdjustedYear$ + RIGHT$(STR$(IncrementMonth), _
  2039.         N2) + RIGHT$(STR$(IncrementDay), N2))
  2040.         Subnum = SubnumSave
  2041.     END SUB
  2042.     '=========================================================================
  2043.     SUB InitPrinter  STATIC
  2044.     '=========================================================================
  2045.     '   Printer Initialization
  2046.     DEFINT A-Z
  2047.         SubnumSave = Subnum
  2048.         Subnum = 33
  2049.     WIDTH LPRINT 84
  2050.     IF SelectedPrinter$ <> Hyphen$ THEN
  2051.         '  Init Printer
  2052.         FOR I = N1 TO 50
  2053.             CALL KeyStuff(KeyStatus)
  2054.             IF PrinterCodes(I) = -99 THEN
  2055.                 EXIT FOR
  2056.               ELSE
  2057.                 CALL LprintString((CHR$(PrinterCodes(I))), N1)
  2058.                 IF LprintTerminate THEN
  2059.                     EXIT FOR
  2060.                 END IF
  2061.             END IF
  2062.         NEXT
  2063.     END IF
  2064.     PrinterLineCount = 1
  2065.         Subnum = SubnumSave
  2066.     END SUB
  2067.     '=========================================================================
  2068.     '========================  END OF CAL3.BAS  =============================
  2069.     '========================================================================
  2070.